SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00059 DISK DRIVE HANDLING ROUTINES 1 05-28-9313:38ALL SWAG SUPPORT TEAM CDROM.PAS IMPORT 124 ╣Φƒ {π> Are there anybody out there who has some routins to play CD Audio in a CDπ> ROM drive. Just the usual commands like play, stop, resume, eject and soπ> on. I would appreciate any help!π}ππUnit CDROM;ππ{ Unit talking to a CD-Rom-Driveπ Low-level CD access,π only the first drive is supported...!π Copyright 1992 Norbert Igl }ππInterfaceππTypeπ CD_Record = Recordπ Status : Word; { Status des Drives/letzte Funktion }π DrvChar: Char; { LW-Buchstabe }π DrvNo : Byte; { als Byte ablegegt (0...) }π HSG_RB : Byte; { Adressierungs-Modus }ππ Sector : LongInt; { Adresse des Lesekopfes }π VolInfo: Array[1..8] of Byte; { Lautst.-Einstellungen }π DevPar : LongInt; { Device-parameter, BIT-Feld! }π RawMode: Boolean; { Raw/Cooked-Mode ? }π SecSize: Word; { Bytes/Sector }π VolSize: LongInt; { sek/Volume => Groesse der CD}ππ MedChg : Byte; { Disk gewechselt? }ππ LoAuTr : Byte; { kleinste Audio-Track # }π HiAuTr : Byte; { groesste Audio-Track # }π endAdr : LongInt; { Adresse der Auslaufrille (8-) }ππ TrkNo : Byte; { Track #. Eingabe-Wert ! }π TrkAdr : LongInt; { Adresse dieses Tracks }π TrkInf : Byte; { Info dazu: BIT-Feld! }ππ CntAdr : Byte; { CONTROL und ADR, von LW }π CTrk : Byte; { track # }π Cindx : Byte; { point/index }π CMin : Byte; { minute\ }π CSek : Byte; { second > Laufzeit im Track }π CFrm : Byte; { frame / }π Czero : Byte; { immer =0 }π CAmin : Byte; { minute \ }π CAsec : Byte; { sekunde > Laufzeit auf Disk }π CAFrm : Byte; { frame / }ππ Qfrm : LongInt;{ start-frame address }π Qtrfs : LongInt;{ Bufferaddresse }π Qcnt : LongInt;{ Anzahl der Sectoren }π { pro Sector werden 96 Byte nach buffer kopiert }ππ Uctrl : Byte; { CONTROL und ADR Byte }π Upn : Array[1..7] of Byte; { EAN-CODE }π Uzero : Byte; { immer = 0 }π Ufrm : Byte; { Frame-# }π end;π OneTrack = Recordπ Title : String[20];π Runmin,π RunSec : Byte;π Start : LongInt; { HSG Format ! }π end;π VolumeTableOfContens = Recordπ Diskname: String[20];π UAN_Code: String[13];π TrackCnt: Byte;π Titles : Array[1..99] of OneTrack;π end;π TrkInfo = Recordπ Nummer : Byte;π Start : LongInt;π Cntrl2 : Byte;π end;π{===== global verfuegbare Variablen =============}ππVar CD : CD_Record;π CD_AVAIL : Boolean;π VtoC : VolumeTableOfContens;π CD_REDPos : String;π CD_HSGPos : String;ππ{===== allgemeine Funktionen ===================}ππFunction CD_Reset : Boolean;πFunction CD_HeadAdr : Boolean;πFunction CD_Position: Boolean;πFunction CD_MediaChanged: Boolean;πππ{===== Tray/Caddy-Funktionen ===================}ππFunction CD_Open: Boolean;πFunction CD_Close: Boolean;πFunction CD_Eject: Boolean;ππ{==== Audio-Funktionen =========================}ππFunction CD_Play(no:Byte; len:Integer): Boolean;πFunction CD_Stop: Boolean;πFunction CD_Resume:Boolean;πFunction CD_SetVol:Boolean;πFunction CD_GetVol:Boolean;ππProcedure CD_Info;πProcedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );ππ{==== Umwandlungen =============================}ππFunction Red2Time( Var Inf:TrkInfo ):Word;ππImplementation Uses Dos;πType IOCtlBlk = Array[0..200] of Byte;ππConst IOCtlRead = $4402;π IOCtlWrite = $4403;π DevDrvReq = $1510;π All:LongInt= $0f00;ππVar R : Registers;π H : Text;π Handle : Word;π Old_Exit : Pointer;π CtlBlk : IOCtlBlk;ππ Tracks : Array[1..100] of TrkInfo;ππProcedure CD_Exit; { wird bei Programmende ausgefuehrt }πbeginπ if Old_Exit <> NILπ then ExitProc := Old_Exit; { Umleitung wieder zuruecknehmen }π{$I-}π Close(H);π If IoResult = 0 then; { 'H' schliessen, falls offen, }π{$I+} { evtl. Fehler verwerfen }πend;πππFunction CD_Init: Boolean; { Initialisierung beim Programmstart }πbeginπ FillChar( CD, SizeOf( CD ), 0);π With R doπ beginπ AX := $1500;π BX := $0000;π CX := $0000;π Intr( $2F, R );π CD_Init := (BX > 0); { Anzahl der CD-Laufwerke }π If BX > 0π then beginπ CD.DrvChar { CD-Laufwerksbuchstabe }π := Char( CL + Byte('A') );π CD.DrvNo := CL;π If CD_HeadAdr thenπ If CD_GetVol then;π endπ else CD.DrvChar := '?'; { im Fehlerfall...}π endπend;ππProcedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );πbeginπ T := Tracks[nr]πend;ππFunction OpenCDHandle:Word;πConst Name : String[8] = 'MSCD001'; { evt. anpassen!!! ? }πbeginπ Assign(H, Name); { Filehandle holen }π(*$I-*)π Reset(H);π(*$I+*)π if IoResult = 0 thenπ beginπ Handle := TextRec(H).Handle; { Filehandle holen }π Old_Exit := ExitProc; { Bei ende/Abbruch muss 'H'... }π ExitProc := @CD_Exit; { ...automatisch geschlossen werden }π endπ else Handle := 0;π OpenCDHandle := Handle;πend;ππProcedure CloseCDHandle;πbeginπ if TextRec(H).Mode <> FmClosedπ then ExitProc := Old_Exit; { Umleitung wieder zuruecknehmen }π Old_Exit := NIL;π{$I-}π Close(H);π If IoResult = 0 then; { 'H' schliessen, falls offen, }π{$I+} { evtl. Fehler verwerfen }πend;πππFunction Red2HSG( Var Inf:TrkInfo ):LongInt;πVar l: LongInt;πbeginπ l := LongInt(( Inf.Start shr 16 ) and $FF ) * 4500;π l := l + LongInt(( Inf.Start shr 8 ) and $FF ) * 75;π l := l + LongInt(( Inf.Start ) and $FF ) ;ππ Red2HSG := l -2;πend;ππFunction Red2Time( Var Inf:TrkInfo ):Word;πbeginπ Red2Time:= (( Inf.Start shr 24 ) and $FF ) shl 8π + (( Inf.Start shr 16 ) and $FF )πend;ππFunction HSG2Red(L:LongInt):LongInt;πbeginπend;ππFunction CD_IOCtl( Func, Len : Word) : Boolean;πbeginπ With R doπ beginπ AX := Func;π BX := OpenCDHandle;π CX := 129;π DS := DSeg;π ES := DS;π DX := Ofs(CtlBlk);π MsDos( R );π CD.Status := AX;π CD_IOCtl := (Flags and FCARRY) = 0;π CloseCDHandle;π endπend;πππFunction CD_Reset: Boolean;πbeginπ CtlBlk[0] := 2; { Reset }π CD_Reset := CD_IoCtl( IoCtlWrite, 1)πend;ππFunction DieTuer( AufZu:Byte ): Boolean;πbeginπ CtlBlk[0] := 1; { die Tuer.. }π CtlBlk[1] := AufZu; { ..freigeben }π DieTuer := CD_IoCTL(IoCtlWrite, 2);πend;ππFunction CD_Open: Boolean;πConst Auf = 0;πbeginπ CD_Open := DieTuer( Auf );πend;ππFunction CD_Close: Boolean;πConst Zu = 1;πbeginπ CD_Close := DieTuer( Zu );πend;πππFunction CD_Eject: Boolean;πbeginπ CtlBlk[0] := 0; { CD auswerfen }π CD_Eject := CD_IOCtl(IoCtlWrite, 1);πend;πππFunction CD_Play(no:Byte; len:Integer): Boolean;πbegin { CD PlayAudio }ππ FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 22; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $84; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π CtlBlk[5] := 0;π CtlBlk[13]:= CD.HSG_RB; { HSG-Modus }ππ CD.Sector := VtoC.Titles[no].Start; { ist im HSG-Format }ππ Move( CD.Sector, CtlBlk[14], 4 ); { Start-Sector }π if len = -1π then All := $FFFFπ else All := len;π Move( All , CtlBlk[18], 4 ); { Anzahl Sectoren}π Asmπ mov ax, $1510π push dsπ pop esπ xor cx, cxπ mov cl, CD.DrvNoπ mov bx, offset CtlBlkπ Int $2fπ end;ππ CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Play := CD.Status and $8000 = 0;ππend;ππFunction CD_VtoC:Boolean;πVar i: Byte;π l: LongInt;πbeginπ FillChar( Tracks, SizeOf( Tracks ), 0);π CtlBlk[0] := 10; { Read LeadOut-Tr }π CD_IoCtl( IoCtlRead, 6);π Move( CtlBlk[1], CD.LoAuTr, 6);π i := CD.HiAuTr+1;π Move( CtlBlk[3], Tracks[i], 4); { die Auslaufrille 8-) }π Tracks[i].Start := Red2Hsg(Tracks[i]);ππ For i := CD.LoAuTr to CD.HiAuTr doπ beginπ FillChar(CtlBlk, SizeOf(CtlBlk), 0); { RED-Book-Format }π CtlBlk[0] := 11; { Read VtoC-Entry }π CtlBlk[1] := i; { track-no }π CD_IoCtl( IoCtlRead, 6);π Move( CtlBlk[1], Tracks[i], 6);π{ Tracks[i].Start := Red2Hsg(Tracks[i]); }π end;πππ With VtoC doπ beginπ DiskName := '';π UAN_Code := '';π TrackCnt := CD.HiAuTr;π For i := CD.LoAuTr to CD.HiAuTr doπ With Titles[i] doπ beginπ L := LongInt((Tracks[i+1].Start shr 16) and $FF) * 60π + (Tracks[i+1].Start shr 8) and $FFπ - ( LongInt((Tracks[i].Start shr 16) and $FF) * 60π + (Tracks[i].Start shr 8) and $FF);π Title := '???';π RunMin := L div 60;π RunSec := l - RunMin*60;π Start := Red2Hsg(Tracks[i]);π endπ end;ππππend;ππFunction CD_Stop: Boolean;πbegin { CD StopAudio }π FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 5; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $85; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π CtlBlk[5] := 0;π Asmπ mov ax, $1510π push dsπ pop esπ xor cx, cxπ mov cl, CD.DrvNoπ mov bx, offset CtlBlkπ Int $2fπ end;ππ CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Stop := CD.Status and $8000 = 0;ππend;πππFunction CD_Resume:Boolean;πbegin { ResumeAudio}π CtlBlk[0] := 3; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $88; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π Asmπ mov ax, Seg @DATAπ mov es, axπ mov ax, DevDrvReqπ lea bx, CtlBlkπ Int 2fhπ end;π CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Resume := CD.Status and $8000 = 0;ππend;ππFunction CD_GetVol:Boolean;πbeginπ CtlBlk[0] := 4; { die Lautstaerke lesen }π CD_GetVol := CD_IOCtl(IoCtlRead, 8);π if ((R.Flags and FCARRY) = 0)π then Move(CtlBlk[1], CD.VolInfo, 8)π else FillChar( CD.VolInfo, 8, 0)πend;ππFunction CD_SetVol:Boolean;πbeginπ CtlBlk[0] := 3; { die Lautstaerke setzen }π CD_SetVol := CD_IOCtl( IoCtlWrite, 8);πend;ππFunction CD_HeadAdr: Boolean;πVar L:LongInt; S:String;πbeginπ FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 1;π CtlBlk[1] := 1; { die KopfPosition im RED-Format }π CD_HeadAdr:= CD_IOCtl(IoCtlRead, 128);π if ((R.Flags and FCARRY) = 0)π then beginπ Move(CtlBlk[2], L, 4);π if CtlBlk[1] = 1 thenπ beginπ STR( CtlBlk[4]:2, S); CD_REDPos := S;π STR( CtlBlk[3]:2, S); CD_REDPos := CD_REDPos+ ':'+ S;π CD.Sector := LongInt(CtlBlk[4]) *4500 +π LongInt(CtlBlk[3]) *75 +π LongInt(CtlBlk[2])π - 150;π end elseπ beginπ CD.Sector := L;π STR(L:0,CD_HSGPos);π endππ endπ else FillChar( CD.Sector, 4, 0);πend;πππFunction CD_Position:Boolean;πVar l : LongInt;πbeginπ CtlBlk[0] := 12; { Audio-Infos }π CD_Position :=CD_IOCtl(IoCtlRead,10);π Move(CtlBlk[1], CD.CntAdr, 10);πend;πππProcedure CD_GetUAN;πbeginπ CtlBlk[0] := 14; { EAN-Nummer }π If CD_IOCtl(IoCtlRead,10)π then Move(CtlBlk[1], CD.Uctrl, 10);πend;πππFunction CD_MediaChanged:Boolean;πbeginπ CtlBlk[0] := 9; { Media-Change }π If CD_IOCtl(IoCtlRead, 1)π then Move(CtlBlk[1], CD.MedChg, 1 );π CD_MediaChanged:= CD.MedChg <> 1πend;ππProcedure CD_Info;πbeginππ { CD_Reset; }ππ If CD_HeadAdr then;ππ CtlBlk[0] := 6; { Device-parameter }π If CD_IOCtl(IoCtlRead, 4)π then Move(CtlBlk[1], CD.DevPar, 4 );ππ CtlBlk[0] := 7; { Sector-Groesse }π If CD_IOCtl(IoCtlRead, 3) { & Modus }π then Move(CtlBlk[1], CD.RawMode, 3 );ππ CtlBlk[0] := 8; { Volume-Groesse }π If CD_IOCtl(IoCtlRead, 4)π then Move(CtlBlk[1], CD.VolSize, 4 );ππ CtlBlk[0] := 12; { Audio-Infos }π If CD_IOCtl(IoCtlRead,10)π then Move(CtlBlk[1], CD.CntAdr, 10);ππ CtlBlk[0] := 11; { Track-Infos }π CtlBlk[1] := CtlBlk[2]; { aktueller... }π If CD_IOCtl(IoCtlRead, 6)π then Move(CtlBlk[1], CD.TrkNo, 6 );ππ CD_VtoC;ππend;ππ{========= minimale Initialisierung =============}πbeginπ CD_Avail := CD_Init;π if CD_Avail then CD_INFOπend. Norbertππ{π--- part 2, a Test -----π}πProgram CDROM_TEST;πUses Crt, cdrom, SbTest;πType a5 = Array[0..4] of Byte;πVar i:Byte;π L : LongInt;π ch : Char;π no,π len : Integer;ππbeginπ ClrScr;π WriteLn('CDROM-Unit TestProgram',#10);π With CD doπ if CD_Avail thenπ beginπ WriteLn('■ CD als Laufwerk ',DrvChar,': gefunden!');π Write ('■ Aktuelle CD: ');ππ Write('(UPN-CODE:');π For i := 1 to 7 do Write(Char( (Upn[i] shr 4) or $30),π Char((Upn[i] and $f) or $30));π WriteLn(#8')');π WriteLn('■ Audio-Tracks : ',loautr,'..',hiautr);π WriteLn(' Laufzeiten : ');π For i := CD.LoAuTr to CD.HiAuTr doπ With VtoC.Titles[i] doπ WriteLn(i,Title:10, RunMin:6,':',RunSec);π no := 1;π len := -1;ππ if CD_Stop thenπ if not CD_Play( no ,len)π then WriteLn('! Fehler-Status: ',STATUS and $F);ππ ch := ' ';π While ch <> #27 doπ beginπ While ch = ' ' doπ With CD doπ beginπ if CD_Position thenπ Write('Playing Track ',CTrk,' : ',CMin:2,':',CSek:2,' '#13);π Delay(1500);π if KeyPressedπ then ch := ReadKey;π end;π Case ch ofπ '+' : Inc(no);π '-' : Dec(no);π end;π if ch <> #27 then ch := ' ';π if no > cd.HiAUTr then Dec(no);π if no < cd.LoAuTr then Inc(no);π if CD_Stopπ then CD_Play(no, len);π end;π cd_stop;π clreol;π WriteLn(' CD stopped...');π endπ else WriteLn('Leider kein CD-ROM gefunden...');πend.ππ 2 05-28-9313:38ALL SWAG SUPPORT TEAM CHANGDRV.PAS IMPORT 30 ╣αÉ { Author: Greg Estabrooks }πProgram DriveInf;πUsesπ Crt, (* ClrScr routine *)π Dos; (* Register Type, Intr() Routine *)πVarπ Regs :Registers; (* To hold register info For Intr() *)π CH :Char; (* To hold Drive to change to *)πππFunction GetDrive :Byte;π (* Routine to Determine the default drive *)πbeginπ Regs.AX := $1900; (* Function to determine drive *)π Intr($21,Regs); (* Call Dos int 21h *)π GetDrive := Regs.AL; (* Return Proper result *)π (* Returns 0 = A, 1 = B, 2 = C, ETC *)πend;ππProcedure ChangeDrive( Drive :Byte );π (* Routine to change default drive *)πbeginπ Regs.AH := $0E; (* Function to change Drives *)π Regs.DL := Drive; (* Drive to change to *)π Intr($21,Regs); (* Call Dos Int 21h *)πend;ππFunction NumDrives :Byte;π (* Routine to determine number of valid drives *)πVarπ CurDrive :Byte; (* Temporary storage For current drive*)πbeginπ CurDrive := GetDrive; (* Find out the current drive *)π Regs.AH := $0E; (* Function to change drives *)π Regs.DL := CurDrive; (* Change to current drive *)π Intr($21, Regs); (* Call Dos *)π NumDrives := Regs.AL; (* Return proper info to user *)πend;ππbeginπ ClrScr; (* Clear the screen *)π (* Write Current Drive to Screen *)π Writeln('Current Drive Is : ',CHR(GetDrive+65 ),':\');π Write('What Drive do you wish to change to ?[A..');π WriteLn(CHR(NumDrives + 64 ),']');π CH := ReadKey; (* Get Choice *)π CH := UpCase( CH ); (* Convert to uppercase *)π ChangeDrive( Ord( CH )-65 ); (* Change to chosen drive *)πend.π(**********************************************************************)πππ{ And here are the above in Inline Asm. I hope these help. }ππFunction GetDrive :Byte; Assembler;π { Routine to Determine the default drive }πAsmπ Mov AX,$1900 { Function to determine drive }π Int $21 { Call Dos int 21h }π { Returns 0 = A, 1 = B, 2 = C, ETC }πend;{GetDrive}ππProcedure ChangeDrive( Drive :Byte ); Assembler;π { Routine to change default drive }π { 0 = A, 1 = B, 2 = C, ETC }πAsmπ Mov AH,$0E { Function to change Drives }π Mov DL,Drive { Drive to change to }π Int $21 { Call Dos Int 21h }πend;{ChangeDrive}ππFunction NumDrives :Byte; Assembler;π { Routine to determine number of valid drives }πAsmπ Call GetDrive { Find out the current drive, Returns }π { Drive in AL }π Mov AH,$0E { Function to change drives }π Mov DL,AL { Change to current drive }π Int $21 { Call Dos }π { Number of drives is returns in AL }πend;{NumDrives}ππ 3 05-28-9313:38ALL SWAG SUPPORT TEAM DEFAULT.PAS IMPORT 9 ╣┬y *--* 03-31-93 - 21:49:00 *--*π/. Date: 03-31-93 (09:51) Number: 24032 of 24035π To: IOANNIS HADJIIOANNOU Refer#: 23844πFrom: LEE BARKER Read: NOπSubj: Current Drive Status: PUBLIC MESSAGEπConf: R-TP (552) Read Type: GENERAL (A) (+)ππ┌─┬─────────────── Ioannis Hadjiioannou ───────────────┬─╖π│o│ How can I find which drive is the default drive? │o║π╘═╧══════════════════════════════════════════════════════════╧═╝πWhile X may mark the spot, period marks/inhibits the drive.ππUses Dos;πbeginπ Writeln(fexpand('.'));πend.ππAs For getting the drive Label look up findfirst With anπattribute of "directory".π---π ■ Tags τ Us ■ Operator! Trace this call and tell me where I amπ * Suburban Software - Home of King of the Board(tm) - 708-636-6694π * PostLink(tm) v1.05 SUBSOFT (#715) : RelayNet(tm) Hubππ(61 min left), (H)elp, end of Message Command? 4 05-28-9313:38ALL SWAG SUPPORT TEAM DETCDRIV.PAS IMPORT 5 ╣à┤ {│o│ How do I detect active drives in Pascal? My Program would │o║π│o│ crash if you Typed in a non-existent drive as either │o║π│o│ source or destination. │o║π}πUses Dos;πVar sr : SearchRec;πbeginπ findfirst('k:\*.*',AnyFile,sr);π if Doserror=0π then Writeln('It is there all right!')π else Writeln('Sorry, could not find it.');πend.ππ 5 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVE-ID.PAS IMPORT 25 ╣ûè {π Below is TP code to do drive-Type identification. I leave it as aπ research exercise For you to create code to differentiate betweenπ a RAM drive and fixed disk, if that's needed.ππ}π(********************************************************************)π Program DrvCount; { coded by Greg Vigneault }π Uses Crt,Dos; { For MsDos Function }π Var Drives :Byte; { count of logical drives }π Reg :Registers; { to access CPU Registers }π ThisDrive :Byte; { loop count }π DriveType :String[16]; { Type of drive found }π DataBuffer :Array [0..127] of Byte; { buffer For Dos i/o }π beginπ ClrScr; { remove screen clutter }π Reg.AH := $19; { get current disk code }π MsDos(Reg); { via Dos }π Reg.DL := Reg.AL; { returned drive code }π Reg.AH := $E; { select disk }π MsDos(Reg); { via Dos }π Drives := Reg.AL; { number of logical drives }ππ WriteLn('Number of logical drives: ', Drives );ππ Intr($11,Reg); { get system equipment flag }π if ( (Reg.AX and 1) <> 0 ) { any floppies installed? }π then WriteLn('(physical floppy drives: ',π (Reg.AX SHR 6) and 3, ')' ); { get bits 6&7 }ππ For ThisDrive := 1 to Drives do begin { scan all drives }π Reg.AX := $440D; { using generic I/O control }π Reg.CX := $860; { to get drive parameters }π Reg.BL := ThisDrive; { For this drive }π Reg.DX := ofs(DataBuffer); { Pointer to scratch buffer }π Reg.DS := Seg(DataBuffer); { in is DS:DX }π MsDos(Reg); { thank you, Dos }π Case ( DataBuffer[1] ) of { which Type it is... }π 0 : DriveType := '360 KB 5.25" FDD';π 1 : DriveType := '1.2 MB 5.25" FDD';π 2 : DriveType := '720 KB 3.5" FDD';π 3 : DriveType := 'SD 8"'; { a relic from CP/M roots }π 4 : DriveType := 'DD 8"'; { ditto }π 5 : DriveType := 'Fixed/RAM disk'; { HDD or RAM }π 6 : DriveType := 'Tape drive'; { a good investment }π 7 : DriveType := '1.44 MB 3.5" FDD' { or "other" drv }π else DriveType := '???'; { anything else }π end; { Case }π WriteLn(' - ', CHR(ThisDrive+64),': (', DriveType, ')' );π { further code could ID between RAM drive & HDD }π end; { For }π end. { Program }π(********************************************************************)π 6 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES1.PAS IMPORT 5 ╣7╖ {πHere are some routines For Changing and detecting drives.π}ππUses Crt, Dos;πVarπ Regs :Registers;ππFunction GetDrive :Byte;πbeginπ Regs.AX := $1900;π Intr($21,Regs);π GetDrive := (Regs.AL + 1);π (* Returns 1 = A:, 2 = B:, 3 = C:, Etc *)πend;ππProcedure ChangeDrive(Drive :Byte);πbeginπ Regs.AH := $0E;π Regs.DL := Drive; (* Drive 1 = A:, 2 = B:, 3 = C: *)π Intr($21,Regs);πend;ππbeginπ ClrScr;π Writeln(' Current Drive : ',CHR( GetDrive+64 ));πend.π 7 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES2.PAS IMPORT 4 ╣Ω) Program DriveID;πUsesπ Dos;πConstπ First : Boolean = True;πVarπ Count : Integer;πbeginπ Write('You have the following Drives: ');π For Count := 3 to 26 doπ if DiskSize(Count) > 0 thenπ beginπ if not First thenπ Write(', ');π First := False;π Write(UpCase(Chr(ord('a') - 1 + Count)),':')π end;π WriteLn;πend.π 8 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES3.PAS IMPORT 10 ╣═╜ { JW│ How do I detect active drives in Pascal? My Program would crash if youπ │ Typed in a non-existent drive as either source or destination.ππHere's the method I use:π}πUsesπ Dos;ππVarπ Isthere : Boolean;ππFunction ChangeDrive( drv: Char ): Boolean;π(*πTakes drive letter as parameter, returns True if changeπsucceeded, False if change failed (invalid drive)π*)πVarπ Regs: Dos.Registers;π NewDrv: Byte;πbeginπ(* Calculate drive code For desired drive *)π NewDrv := orD( UpCase( drv ) ) - orD( 'A' ); (* A: = 0 *)ππ(* Change drive *)π Regs.DL := NewDrv;π Regs.AH := $0E; (* Function 0Eh: Select Disk *)π MSDos( Regs );ππ(* See if the change 'took' *)π Regs.AH := $19; (* Function 19h: Get current drive *)π MSDos( Regs );π ChangeDrive := (Regs.AL = NewDrv);πend; (* ChangeDrive *)ππbeginπ isthere := ChangeDrive('a');π Writeln ('a: ',isthere);π isthere := ChangeDrive('b');π Writeln ('b: ',isthere);π isthere := ChangeDrive('c');π Writeln ('c: ',isthere);π isthere := ChangeDrive('d');π Writeln ('d: ',isthere);π isthere := ChangeDrive('e');π Writeln ('e: ',isthere);πend.π 9 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES4.PAS IMPORT 35 ╣└Z {π> Does anyone know if there is a way For a Pascal Program to determineπ> whether a drive is a local hard drive, a network drive, a Dosπ> SUBSTituted drive, or a RAMDRIVE?ππHmm... I'm reading this one week after it got posted. and a month after theπoriginal question. I haven't read last week's messages, hope you hadn'tπrecieved to many answers about this now. But because you apparently hadn't gotπanything two weeks after asking, I thought you may want this, so here comes...ππThere is a service in Dos that identifies a given drive as local or remote.πThis service also tells you if the drive is SUBSTed. You can also get infoπabout whether it Uses removable media from another service. There is no way toπdetect a RAM-drive, as Far as I know, and I've got the facts from Microsoft'sπown MSJ! The Dos 5 DosSHELL simple checks the volume identifier. if it'sπ'MS-RAMDRIVE', 'RDV' or 'VDISK', the drive is ASSUMED to be a RAM-disk. Butπit's, again according to Microsoft Systems Journal, impossible to foolproofπcheck if a drive is a logical RAM-drive. A design flaw in Dos.ππHowever, I will show a few lines of TP-code For checking if a drive is remoteπor local, and SUBSTed or not. I use the TP 5.5 (and older) method of Intr-callsπFor simulating Asm, of course if could be written clearer With TP6'sπAsm-keyWord. The code consists of the actual Function and a test stub, cut theπstub when you have looked at it. Code Compiles and runs fine on my system; Iπcouldn't test if it work With remote drives, but it should. I've used similarπcode that worked With that too, so...ππ}πProgram TestDrv;ππ{ --- A very short test-Program For Dos-IOCTL, Jacob Stedman 930223 --- }ππUsesπ Dos;ππFunction IsDriveValid(cDrive: Char; Var bLocal, bSUBST: Boolean): Boolean;π{π Parameters: cDrive is the drive letter, 'A' to 'Z', that's aboutπ to be checked. if not in this range, the Function will return False.ππ Returns: Function returns True if the given drive is valid, elseπ False (!). bLocal is set if drive is local, bSUBST if drive isπ substituted. if Function returns False, the Booleans are undefined.π}πVarπ rCPU: Dos.Registers;πbeginπ { --- Call Dos and process returns --- }π if not (UpCase(cDrive) in ['A'..'Z']) then { --- letter OK?--- }π IsDriveValid := Falseπ elseπ beginπ { --- Valid letter, set up For the Dos-call --- }π rCPU.bx := ord(UpCase(cDrive))-ord('A')+1;π rCPU.ax := $4409;π { --- Call the Dos IOCTL (InOutConTroL)-Functions --- }π Intr($21, rCPU);π if (rCPU.ax and FCarry) = FCarry thenπ IsDriveValid := Falseπ elseπ begin { --- drive is valid, check status --- }π IsDriveValid := True;π bLocal := ((rCPU.dx and $1000) = $0000);π if bLocal thenπ bSUBST := ((rCPU.dx and $8000) = $8000)π elseπ bSUBST := False;π end;π end;πend;ππVarπ cCurChar : Char; { loop counter, drive }π bLocal,π bSUBST : Boolean; { drive local/remote?; SUBSTed or not? }ππbeginπ { --- Write header --- }π Writeln; Writeln(' VALID DRIVES:'); Writeln;π { --- Loop from 'A' to 'Z', For each iteration check a drive --- }π For cCurChar := 'A' to 'Z' doπ if IsDriveValid(cCurChar, bLocal, bSUBST) thenπ beginπ Write(cCurChar, ': ');π if bLocal thenπ Write(' local ')π elseπ Write(' remote');π if bSUBST thenπ Write(' SUBSTed ')π elseπ Write(' not SUBSTed');π Writeln;π end;π { --- Write footer --- }π Writeln;πend.ππ{πThe code is simple. It calls the Dos IOCTL-service #09h, 'Is Drive Remote',πwith the drive number (1-A:, 2-B:, ...) in the bl-register. if the drive isn'tπvalid, the carry flag is set. if valid, carry is clear, and the dx-registerπcontains bit-fields you're interested in. Bit 12 is 1 if remote, 0 if local. ifπlocal, bit 15 is 1 if the drive is a substitution. In TP, you get access toπthem, in this Case, by using the 'and'-binary operator.ππI guess you're interested in making a Filemanager or a report util or thatπlike. then, you're maybe interested to get source For detection of CD-ROMπdrives and floppys? if so, post me a new msg. I always like to recieve newπmail... I didn't include this here, this msg is too long without that extraπcode. Feel free to Write if you get any problems.π} 10 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES5.PAS IMPORT 16 ╣[H {πAuthor : MARCO MILTENBURGππHere's an overview of INT13h, Function 8 :ππName : Get drive parametersππInput : AH = 08hπ DL = <drive> 00h - 7Fh : Floppy diskπ 80h - FFh : HarddiskππOutput: if succesfullπ -------------π Carry is clearedπ BL = <driveType> 01 : 360 KBytes, 40 tracks, 5.25 Inchπ 02 : 1,2 MBytes, 80 tracks, 5.25 Inchπ 03 : 720 KBytes, 80 tracks, 3.5 Inchπ 04 : 1,44 MBytes, 80 tracks, 3,5 Inchπ CH = Lower 8 bits of maximum cylindernumberπ CL = bits 6-7 : Highest 2 bits of maximum cylindernumberπ bits 0-5 : Maximum sectornumberπ DH = Maximum headnumberπ DL = Number of connected drivesπ ES:DI = Pointer to disk drive parameter tableππ if failedπ ---------π Carry is setπ AH = errorstatusππAs you can see, you must do more to get the cylindernumber. Here's a littleπpascal code :π}ππUsesπ Dos;ππConstπ DriveTypes : Array[0..4] of String[18] = ('Harddisk ',π '360 kB - 5.25 Inch',π '1.2 MB - 5.25 Inch',π '720 kB - 3.5 Inch ',π '1.44 MB - 3.5 Inch');πVarπ Regs : Registers;πbeginπ Regs.AH := $08;π Regs.DL := $80;π Intr($13, Regs);ππ WriteLn ('DriveType : ', DriveTypes[Regs.BL]);π WriteLn ('Cylinders : ', 256 * (Regs.CL SHR 6) + Regs.CH + 1);π WriteLn ('Sectors : ', Regs.CL and $3F);π WriteLn ('Heads : ', Regs.DH + 1);ππend.π{πThis will give you the right information from your diskdrives. I noticed thatπmy harddisks will always be reported as driveType 0 (zero). I don't know forπsure if that is documented, but it seems to be logical ;-).π} 11 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVES6.PAS IMPORT 23 ╣áÇ {πAuthor : GAYLE DAVISππ> It will check For example, drive A:, and if there is no disk in theπ>drive it will return False, if it is ready it will return True..ππThere is a problem that you will have to deal With here from the beginning.πFirst of all Dos can't easily tell if the problem is that you drive door isπopen, say in drive 'A', or if the disk is unformatted or unreadable. Hereπis some code that I use to solve the problem using INT25. do not TRY THISπON A HARD DRIVE.π}πUsesπ Dos;ππFunction DisketteDrives : Integer;πVarπ Regs : Registers;πbeginπ FILLChar (Regs, SIZEOF (Regs), #0);π INTR ($11, Regs);π if Regs.AX and $0001 = 0 thenπ DisketteDrives := 0π elseπ DisketteDrives := ( (Regs.AX SHL 8) SHR 14) + 1;πend;ππFunction IsDriveReady (DriveSpec : Char) : Boolean; {A,B,etc}πVarπ result : Word;π Drive,π number,π logical : Word;π buf : Array [1..512] of Byte;π Regs : Registers;πbeginπ IsDriveReady := True; { Assume True to start }π Drive := ORD (UPCASE (DriveSpec) ) - 65; { 0=a, 1=b, etc }ππ if Drive > DisketteDrives thenπ Exit; { do not CHECK HARD DRIVES }ππ number := 1;π logical := 1;ππ Inline (π $55 / { PUSH BP ; Interrupt 25 trashes all}π $1E / { PUSH DS ; Store DS }π $33 / $C0 / { xor AX,AX ; set AX to zero }π $89 / $86 / result / { MOV Result, AX ; Move AX to Result }π $8A / $86 / Drive / { MOV AL, Drive ; Move Drive to AL }π $8B / $8E / number / { MOV CX, Number ; Move Number to CX }π $8B / $96 / logical / { MOV DX, Logical; Move Logical to DX }π $C5 / $9e / buf / { LDS BX, Buf ; Move Buf to DS:BX }π $CD / $25 / { INT 25h ; Call interrupt $25 }π $5B / { POP BX ; Remove the flags valu fr}π $1F / { POP DS ; Restore DS }π $5D / { POP BP ; Restore BP }π $73 / $04 / { JNB Done ; Jump ... }π $89 / $86 / result); { MOV Result, AX ; move error code to AX }π { Done: }ππ IsDriveReady := (result = 0);πend;ππ(*πAlso, you could change the ISDRIVEREADY Function if you wanted to find outπWHY the drive isn't ready by checking the LO(result). Like this :ππ if result <> 0 thenπ beginπ Case LO (result) OFπ 0 : FloppyState := WritePROTECT; { should not ever happen }π 1..4 : FloppyState := DOOROPEN;π 5..12 : FloppyState := NOFORMAT;π elseπ FloppyState := DOOROPEN;π endπ endπ elseπ FloppyState := DRIVEREADY;π*)π 12 05-28-9313:38ALL SWAG SUPPORT TEAM DRIVNAME.PAS IMPORT 9 ╣ {πBO BendTSENππ> There's already a methode For finding all available drives withoutπ> accessing them - I'd like to have one to get the volume Labels of theπ> harddisks, SUBST- and network-drives without waiting seconds While theπ> Program accesses all the 20 drives available in my system ... ;-)ππTry this, it will show any SUBST drives, if a \\ first in the name is returnedπyou will have a network server name following.π}πUsesπ Dos;ππFunction ResolvePath(Var s : String) : Boolean;πVarπ r : Registers;π x : Byte;πbeginπ ResolvePath := False;π s := s + #0;π r.ds := Seg(S);π r.si := Ofs(S) + 1;π r.es := Seg(S);π r.di := Ofs(S) + 1;π r.ah := $60;π Intr($21, R);π If r.flags and 1 = 1 Thenπ Exit; { if ZF set then error }π ResolvePath := True;π x := 0;π While (s[x + 1] <> #0) And (x < 128) Doπ Inc(x);π s[0] := Chr(x);πend;ππVarπ DriveName : String;ππbeginπ DriveName := 'C';π Writeln(ResolvePath(DriveName));π Writeln(DriveName);πend.π 13 05-28-9313:38ALL SWAG SUPPORT TEAM EXIST-DD.PAS IMPORT 45 ╣÷≈ {π»Hey.. do you know anything about checking For the existance of a diskπ»drive without actually needing a disk to be in the drive? (i.e aπ»floppy?)ππTry reading the floppy and then test the error code. Heck, you can get allπthe info you would ever like to have about that drive. I went diggingπthrough my Files and found this.π}πUsesπ Dos;ππTypeπ bootrecptr = ^bootRecord;π bootRecord = Recordπ nj : Array[0..2] of Byte; {offset 0 Near jump code }π oem : Array[0..7] of Byte; { 3 OEM name and ver }π Bytesec : Word; { 11 Bytes/Sector }π sectclus : Byte; { 13 Sectors/cluster }π ressect : Word; { 14 Reserved sectors }π fattables: Byte; { 16 FAT tables }π direntrys: Word; { 17 Directory entries}π logsec : Word; { 19 Logical sectors }π MDS : Byte; { 21 Media descriptor }π FatSects : Word; { 22 FAT sectors }π Secstrak : Word; { 24 Sectors/track }π NumHeads : Word; { 26 Number of heads }π HidnSecs : Word; { 28 Hidden sectors }π bootcode : Array[0..415] of Byte; { 30 boot code }π partcode : Array[0..15] of Byte; { 446 partition info }π bootcode2: Array[0..49] of Byte; { 462 rest of boot code}π end;ππVarπ boot : bootRecord; { the boot Record Variable }ππ{$L DiskInfo}π { an Object File that allows For reading Absolute disk sectors }π{$F+}πFunction diskread(drive: Byte; starting_sector: LongInt;π number_of_sectors: Word; Var buffer): Word; external;π { - read a disk sector Absolutely }π{$F-}ππProcedure bootlook(Drive : Char);πVarπ ReadResult : Word;π I : Integer;πbeginπ { Get diskette info }π ReadResult := DiskRead(ord(Drive)-ord('A'),0,1,boot);π if ReadResult <> 0 thenπ beginπ { Error code here }π endπ elseπ beginπ { read went ok, do something }π end;πend; { Procedure bootlook }π{ππ--------------------- CUT HERE -----------------------π; This part goes through Turbo Assemblerπ;π; Diskread Procedureπ;ππ.286Pπ.8087ππCODE segment Byte Publicππ; Conditional jumps are all coded With the SHorT qualifier inπ; order to minimize the size of the .OBJ File output of Turboπ; Assembler.π;--------------------------------------------------------------------π Assume cs:CODE, ds:DATA, es:nothingπ public DISKREADππDISKREAD proc Farπ; On entry:π; BPπ; SP => Near return addressπ; offset of disk bufferπ; segment " " "π; number of sectors to readπ; starting logical sector numberπ; drive number (0=A, 1=B, etc.)π;π; On Exit:π;π; AX = Function resultπ; 00 - Function successfulπ; 01..FF - Dos inT 25H error resultπ drive equ [bp + 16]π starting_sector equ [bp + 12]π number_of_sectors equ [bp + 10]π buffer equ [bp + 6]ππ push bpπ mov bp,spπ mov ax,3000h ;get Dos versionπ int 21hπ cmp al,4 ;Dos 4?π jge read4 ;We have 4 or newer, so use Extendedπ push es ;save regsπ push dsπ mov dl,drive ;get drive number (0=A,1=B,etc)π mov ah,32h ;get driver parameter blockπ int 21hπ push ds ;move ds to esπ pop esπ pop ds ;restore original dsπ les bx,[es:bx + 12h] ;point ES:BX to device driverπ mov ax,[es:bx + 4] ;get device attributesπ pop esπ test ax,2 ;check if bit 1 setπ jz read3 ;wasn't, so use old methodππread4:π mov al,driveπ mov bx,starting_sector ;copy info into parameter blockπ mov extd_starting_sector_lo,bxπ mov bx,starting_sector + 2π mov extd_starting_sector_hi,bxπ mov bx,number_of_sectorsπ mov extd_number_of_sectors,bxπ les bx,buffer ;get seg:ofs of buffer in ES:BXπ mov extd_bufofs,bx ;put into blockπ mov extd_bufseg,esπ mov bx,offset Dos4_block ;DS:BX points to blockπ mov cx,-1 ;-1 means Extended readπ push ds ;save DS (not Really needed, but letsπ ;me share code With Dos 3 read.)π jmp short readitπread3: mov al,driveπ mov dx,starting_sectorπ mov cx,number_of_sectorsπ push dsπ lds bx,buffer ;get seg:ofs of buffer in DS:BXπreadit: int 25Hπ inc sp ; fix broken stackπ inc spπ pop dsπ jc short diskread_01π xor ax,axπdiskread_01:π pop bpπ ret 10πDISKREAD endpπ} 14 05-28-9313:38ALL SWAG SUPPORT TEAM EXIST-HD.PAS IMPORT 7 ╣╫ Program CheckForHDExistence;πUsesπ Dos;ππFunction checkdsk(drive:Char):Boolean;πbeginπ checkdsk:=disksize(Byte(upcase(drive))-64)>0;πend;ππbeginπ { Doesn't work For Floppies unless a disk is present }π if checkdsk('A') then Writeln('Valid! A')π else Writeln('Not Valid A');π if checkdsk('B') then Writeln('Valid! B')π else Writeln('Not Valid B');π if checkdsk('C') then Writeln('Valid! C')π else Writeln('Not Valid C');π if checkdsk('D') then Writeln('Valid! D')π else Writeln('Not Valid D');π if checkdsk('E') then Writeln('Valid! E')π else Writeln('Not Valid E');π if checkdsk('F') then Writeln('Valid! F')π else Writeln('Not Valid F');πend.ππ 15 05-28-9313:38ALL CHRIS PRIEDE Find LASTDRIVE in ASM IMPORT 7 ╣(─ Function LastDrive: Char; Assembler;πAsmπ mov ah, 19hπ int 21hπ push ax { save default drive }π mov ah, 0Ehπ mov dl, 19hπ int 21hπ mov cl, alπ dec cxπ@@CheckDrive:π mov ah, 0Eh { check if drive valid }π mov dl, clπ int 21hπ mov ah, 19hπ int 21hπ cmp cl, alπ je @@Validπ dec cl { check next lovest drive number }π jmp @@CheckDriveπ@@Valid:π pop axπ mov dl, alπ mov ah, 0Ehπ int 21h { restore default drive }π mov al, clπ add al, 'A'πend;πππ(*πLastDrive will return letter of the last valid drive. To checkπif the drive letter entered is valid:ππif Upcase(DriveLetter) <= LastDriveπ then {valid drive}π else {bad drive};π*) 16 05-28-9313:38ALL SWAG SUPPORT TEAM SERIALNM.PAS IMPORT 14 ╣╪ {π>How can [a disk serial number] be read from TP? Can it be changed other thanπ>by re-Formatting? I can't find any reference to serial numberπ>in the Dos 5.0 users guide except a passing one in the sectionπ>on the ForMAT command.π}πUses Dos;πVar regs : Registers;π LabelInfo : Recordπ InfoLevel : Word; {Always 0}π SerialNum : LongInt;π VolumeLabel : Array [1..11] of Char;π FileSystemType : Array [1..8] of Char;π end;πbeginππ if lo(DosVersion)<4 thenπ beginπ Writeln ('Only works With Dos 4.0 or higher');π Exit;π end;ππ LabelInfo.InfoLevel := 0; {Set Info level (0 is the only legal value)}π With regs doπ beginπ ax := $6900; {Function $69 With 0 in AL gets, With 1 in AL sets}π bl := 0; {Drive, 0 For default, 1 For A:, 2 For B:, ...}π ds := seg(LabelInfo); {DS:DX points at structure}π dx := ofs(LabelInfo);π es := 0; {Do not have garbage in segment Registers}π flags := 0; { or in flags}ππ MsDos(Regs);ππ if Odd(flags) then {Carry set if error}π beginπ Case AX ofπ 1: Writeln ('Illegal attempt to get Label from network drv');π 5: Writeln ('No Extended BPB on disk (Format old)');π else Writeln ('Unknown error');π end;π end;π end;ππ{On return, fills SerialNum, VolumeLabel, and FileSystemType fields.π places 'FAT12 ' or 'FAT16 ' in FileSystemType, For 12- or 16-bit FATπentries. With AL=1, will use info you store in LabelInfo to set disk'sπextended BPB}π 17 05-28-9313:38ALL SWAG SUPPORT TEAM TRUENAME.PAS IMPORT 6 ╣ûß Program TrueName; uses DOS;ππ function RealName(FakeName:String):String;π Var Temp:String;π beginπ FakeName := FakeName + #0; { ASCIIZ }π With Regs doπ beginπ AH := $60;π DS := Seg(FakeName); SI := Ofs(FakeName[1]);π ES := Seg(Temp); DI := OfS(Temp[1]);π INTR($21,Regs);π DOSERROR := AX * ((Flags And FCarry) shr 7);π Temp[0] := #255;π Temp[0] := CHAR(POS(#0,Temp)-1);π end;π If DosError <> 0 then Temp := '';π RealName := Temp;π end;ππbegin writeln( RealName( Paramstr(1) ) end.π 18 05-28-9313:38ALL SWAG SUPPORT TEAM VOL-ID.PAS IMPORT 20 ╣m {π In the thread concerning copy protection (in which I have noπ interest) the serial number of a disk was mentioned.π How can this be read from TP? Can it be changed other thanπ by re-Formatting? I can't find any reference to serial numberπ in the Dos 5.0 users guide except a passing one in the sectionπ on the ForMAT command.ππReading the volume id number is no problem:ππreads volume id number -- not sophisticated enough toπdetermine whether disk was Formatted With a Dos versionπnew enough to assign volume id }ππUses Dos;ππFunction Byte2HexSt(b : Byte) : String;πConstπ hexChars: Array [0..$F] of Char =π '0123456789ABCDEF';πbeginπ Byte2HexSt := hexChars[b shr 4] + hexChars[b and $F];πend;ππProcedure ResetDisk(DriveNo : Byte);πVarπ reg : Registers;πbeginπ reg.ah := 0; { bios Function reset drive system }π reg.dl := DriveNo;π intr($13,reg);πend;ππFunction VolIDSt(DriveCh : Char) : String;π{ returns Volume ID number as a String of hex digits }πVarπ reg : Registers;π try : Integer;π buff : Array[0..1023] of Byte;πbeginπ DriveCh := upCase(DriveCh);π try := 0;π Repeatπ reg.ax := $0201; { ah = bios Function read disk sector }π { al = read 1 sector }π reg.cx := $0001; { ch = cylinder number }π { cl = sector number }π reg.dh := 0; { head number }π reg.dl := ord(DriveCh) - 65; { drive number }π reg.es := seg(buff);π reg.bx := ofs(buff);π intr($13,reg);π inc(try);π if reg.flags and FCarry <> 0 then ResetDisk(reg.dl);π Until ((reg.flags and FCarry) = 0) or (try = 3);π if reg.flags and FCarry <> 0π then VolIDSt := 'Error attempting to read volume ID number'π else VolIDSt := Byte2HexSt(buff[$2A]) +π Byte2HexSt(buff[$29]) + '-' +π Byte2HexSt(buff[$28]) +π Byte2HexSt(buff[$27]);πend;ππ{πCan the volume id number be changed? You bet.ππAlthough it is True that DISKCOPY will not copy the volume idπnumber from the original disk, it's still a pretty weak basis For aπcopy protection scheme. I consider myself a pretty unsophisticatedπProgrammer, but it only took me a few minutes of fooling around toπfigure out where the volume id number is on the disk. then all youπhave to do is grab an interrupt reference and quickly Type up someπcode to read and Write to the right spot on the disk.π}π 19 05-28-9313:38ALL SWAG SUPPORT TEAM VOL-SER1.PAS IMPORT 18 ╣|ö {π This Turbo Pascal code will read the serial number and volumeπ from disks that have been Formatted under Dos 4.0 and higher ...π}π(*-------------------------------------------------------------------*)πProgram VolSN; { reads disk serial number & volume Label (Dos 4.0+) }πUses Dos;πType MediaID = Recordπ InfoLevel : Word;π SerialN : LongInt;π VLabel : Array [0..10] of Char;π SysName : Array [0..7] of Char;π end;ππVar IDbuffer : MediaID;π SerialNumber : LongInt;π VolumeLabel : String[12];π Reg : Registers;π loopc : Byte;πbeginπ WriteLn( #10, 'VolStat 0.00 Greg Vigneault', #10 );ππ Reg.AH := $30; { Function to get Dos version number }π MsDos( Reg ); { via MS-Dos }π if ( Reg.AL < 4 ) or ( Reg.AL = 10 )π then begin { must be Dos 4.0 or above (& not OS/2?) }π WriteLn( 'Dos version error',#7 );π Halt(1) { abort Program }π end;ππ Reg.AX := $6900; { Dos Function }π Reg.BL := 0; { Drive (0=current,1=A,2=B,etc)}π Reg.DS := Seg( IDbuffer ); { place to return data }π Reg.DX := ofs( IDbuffer );π MsDos( Reg ); { call Dos }π { there'll be an error if disk doesn't have a serial # ... }π if ( Reg.FLAGS and 1 ) <> 0 { carry flag set? }π then beginπ WriteLn( 'Dos error getting Media ID',#7 );π Halt(2);π end;ππ SerialNumber := IDbuffer.SerialN; { get serial number }ππ WriteLn( 'Disk serial number: ', SerialNumber );ππ VolumeLabel := '';π loopc := 0;π While ( IDbuffer.VLabel[ loopc ] <> ' ' )π do beginπ VolumeLabel[ loopc+1 ] := IDbuffer.VLabel[ loopc ];π inC( loopc );π end;π VolumeLabel[0] := CHR( loopc ); { set TP String length }π if ( loopc <> 0 ) thenπ WriteLn( 'Disk volume Label : ', VolumeLabel );πend.π 20 05-28-9313:38ALL SWAG SUPPORT TEAM VOL-SER2.PAS IMPORT 17 ╣ ╝ {π>Who can give me the source code in TP 6.0 which reads a HardDisks Volumeπ>Serial Number ?ππStarting With Dos 4 this inFormation can be GET/SET using inT 21h func 69hπ Entry AH =69hπ Al = 00h Get Serial number and Labelπ Al = 01h Set Serial numberπ BL = drive number 0=default, 1=A: .....)π DS:DX Pointer to a 24 Bytes Buffer (see below)π Returnπ Cf set on errorπ AX = error code (same as Int 21h AH = 59 )π CF Clear if Okπ if AL was 0 then Buffer is filled withπ offset size Contents:π 0 Word 0π 2 DWord the disk Serial numberπ 6 11 Bytes= volume Label or "NO NAME"π 16 8 Bytes = 'FAT12' or 'FAT16'ππ The buffer is actually a copy of ByteS $27 to $3D of the Sector 0 of the diskπ So With previous versions of Dos one should be able to do an Absolute readπ of sector 0 from the disk and extract the Info from a buffer. I did not dareπ doing it....ππ Last Thought: With Dos earlier than 4 , there was no disk serial numberπ so what the point looking For one .... !!!!π Although this info can be used to set one ???π (not by me... I need too badly my hard disk toπ experiment With Int 13h ..... )ππ Here is a Program that Get these Infos...π I did not dare trying the Set Function (AL=1...) see above...π}πProgram GetSerial;πUsesπ Dos;πVarπ Buffer : Array[0..23] of Byte;π R : Registers;π Serial : LongInt;π VLabel : String[11];π Fat : String[8];πbeginπ R.AH := $69;π R.AL := 0;π R.BL := 3; { C: Drive }π R.DS := Seg(Buffer);π R.DX := ofs(Buffer);π Intr($21,R);π if (R.Flags and Fcarry = 0) thenπ beginπ Move(Buffer[2], Serial, Sizeof(LongInt));π Move(Buffer[6], VLabel[1], 11);π VLabel[0] := Char(11);π Move(Buffer[16], Fat[1], 8);π Fat[0] := Char(8);π end;π Writeln(VLabel);π Writeln(Fat);π readln;πend.π 21 05-28-9313:38ALL SWAG SUPPORT TEAM VOLABEL1.PAS IMPORT 30 ╣Ç > I need a way to find the volume Label of a drive. Any suggestions orπ> source code?ππ{$S-,R-,V-,I-,N-,B-,F-}ππUnit Volume;ππInterfaceππUsesπ Dos;ππTypeππ Drive = Byte;π VolumeName = String [11];ππ VolFCB = Recordπ FCB_Flag : Byte;π Reserved : Array [1..5] of Byte;π FileAttr : Byte;π Drive_ID : Byte;π FileName : Array [1..8] of Byte;π File_Ext : Array [1..3] of Byte;π Unused_A : Array [1..5] of Byte;π File_New : Array [1..8] of Byte;π fExt_New : Array [1..3] of Byte;π Unused_B : Array [1..9] of Byteπ end;ππFunction DelVol (D : Byte) : Boolean;πFunction AddVol (D : Byte; V : VolumeName) : Boolean;πFunction ChgVol (D : Byte; V : VolumeName) : Boolean;πFunction GetVol (D : Byte) : VolumeName;ππImplementationππProcedure Pad_Name (Var V : VolumeName);πbeginπ While LENGTH (V) <> 11 DOπ V := V + ' 'πend;ππFunction Fix_Ext_Sym (Var V : VolumeName) : Byte;πVarπ I : Byte;πbeginπ I := POS ('.', V);π if I > 0 thenπ DELETE (V, I, 1);π Fix_Ext_Sym := Iπend;ππFunction Extract_Name (S : SearchRec) : VolumeName;πVarπ H, I : Byte;πbeginπ I := Fix_Ext_Sym (S.Name);π if (I > 0) and (I < 9) thenπ For H := 1 to (9 - I) DOπ INSERT (' ', S.Name, I);π Extract_Name := S.Nameπend;ππProcedure Fix_Name (Var V : VolumeName);πVarπ I : Byte;πbeginπ Pad_Name (V);π For I := 1 to 11π do V [I] := UPCASE (V [I])πend;ππFunction Valid_Drive_Num (D : Byte) : Boolean;πbeginπ Valid_Drive_Num := (D >= 1) and (D <= 26)πend;ππFunction Find_Vol (D : Byte; Var S : SearchRec) : Boolean;πbeginπ FINDFIRST (CHR (D + 64) + ':\*.*', VolumeID, S);π Find_Vol := DosError = 0πend;ππProcedure Fix_FCB_NewFile (V : VolumeName; Var FCB : VolFCB);πVarπ I : Byte;πbeginπ For I := 1 to 8 DOπ FCB.File_New [I] := ORD (V [I]);π For I := 1 to 3 DOπ FCB.fExt_New [I] := ORD (V [I + 8])πend;ππProcedure Fix_FCB_FileName (V : VolumeName; Var FCB : VolFCB);πVarπ I : Byte;πbeginπ For I := 1 to 8 DOπ FCB.FileName [I] := ORD (V [I]);π For I := 1 to 3 DOπ FCB.File_Ext [I] := ORD (V [I + 8])πend;ππFunction Vol_Int21 (Fnxn : Word; D : Drive; Var FCB : VolFCB) : Boolean;πVarπ Regs : Registers;πbeginπ FCB.Drive_ID := D;π FCB.FCB_Flag := $FF;π FCB.FileAttr := $08;π Regs.DS := SEG (FCB);π Regs.DX := OFS (FCB);π Regs.AX := Fnxn;π MSDos (Regs);π Vol_Int21 := Regs.AL = 0πend;ππFunction DelVol (D : Byte) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;π V : VolumeName;πbeginπ DelVol := False;π if Valid_Drive_Num (D) thenπ beginπ if Find_Vol (D, sRec) thenπ beginπ V := Extract_Name (sRec);π Pad_Name (V);π Fix_FCB_FileName (V, FCB);π DelVol := Vol_Int21 ($1300, D, FCB)π endπ endπend;ππFunction AddVol (D : Byte; V : VolumeName) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;πbeginπ AddVol := False;π if Valid_Drive_Num (D) thenπ beginπ if not Find_Vol (D, sRec) thenπ beginπ Fix_Name (V);π Fix_FCB_FileName (V, FCB);π AddVol := Vol_Int21 ($1600, D, FCB)π endπ endπend;ππFunction ChgVol (D : Byte; V : VolumeName) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;π x : Byte;πbeginπ ChgVol := False;π if Valid_Drive_Num (D) thenπ beginπ if Find_Vol (D, sRec) thenπ beginπ x := Fix_Ext_Sym (V);π Fix_Name (V);π Fix_FCB_NewFile (V, FCB);π V := Extract_Name (sRec);π Pad_Name (V);π Fix_FCB_FileName (V, FCB);π ChgVol := Vol_Int21 ($1700, D, FCB)π endπ endπend;ππFunction GetVol (D : Byte) : VolumeName;πVarπ sRec : SearchRec;πbeginπ GetVol := '';π if Valid_Drive_Num (D) thenπ if Find_Vol (D, sRec) thenπ GetVol := Extract_Name (sRec)πend;ππend.π 22 05-28-9313:38ALL SWAG SUPPORT TEAM VOLABEL2.PAS IMPORT 35 ╣πL {πCould somebody help me out here? I'm trying to Write aπProgram that reads the File names and their attributes fromπdisk/drive.ππUnit volLabel;ππ Type String11 = String[11];π Function GetCurrentVolumeLabel : String11;π Procedure DelVolumeLabel(CurrentVolumeLabel:String11);π Procedure WriteVolumeLabel(CurrentVolumeLabel:String11);π ( to change a volume Label: delete old, then Write new )π}ππ(* Implementation *)ππUsesπ Dos;ππVarπ oldir : String; { only For test Program }ππTypeπ ExtendedFCBType = Recordπ ExtendedFCBflag : Byte;π Reserved1 : Array[1..5] of Byte;π Attr : Byte;π DriveID : Byte;π FileName : Array[1..8] of Char;π FileExt : Array[1..3] of Char;π CurrentBlockNum : Word;π RecordSize : Word;π FileSize : LongInt;π PackedDate : Word;π PackedTime : Word;π Reserved2 : Array[1..8] of Byte;π CurrentRecNum : Byte;π RandomRecNum : LongInt;π end;ππType String11 = String[11];πFunction GetCurrentVolumeLabel : String11;πVarπ CurrentDrive: String;π VolumeLabel : SearchRec; { defined in the Dos Unit }π i : Word;πbegin { 12345678901 }π GetCurrentVolumeLabel:= 'no Label ';π getdir(0,CurrentDrive); {in Dos Unit }π CurrentDrive:= copy(CurrentDrive,1,3) + '*.*';π {get Volume Label in A: drive}π findfirst(CurrentDrive,VolumeID,VolumeLabel);π if Doserror=0 thenπ With VolumeLabel doπ beginπ {remove period}π delete(VolumeLabel.name,pos('.',VolumeLabel.name),1);π { pad to 11 Chars }π For i:= length(name) to 11 do name:= name + ' ';π GetCurrentVolumeLabel:= name;π end; { With VolumeLabel}πend; {of GetCurrentVolumeLabel }ππProcedure DelVolumeLabel(CurrentVolumeLabel:String11);π{delete volume Label from disk in current drive}πVarπ regs : Registers;π FCB : ExtendedFCBType;πbeginπ fillChar(FCB,sizeof(FCB),#0); {initialize FCB With nulls }π With FCB doπ beginπ ExtendedFCBflag:= $ff; { always }π Attr := VolumeID; {defined in the Dos Unit}π DriveID := 0; {default drive}π move(CurrentVolumeLabel[1],FileName,8); {you have to put these in}π move(CurrentVolumeLabel[9],FileExt ,3); {For some silly reason }π end; { With FCB do }ππ { set up regs For Dos call }π fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}π regs.ah:= $13; {Dos 1.0 delete File Function}π regs.ds:= seg(FCB);π regs.dx:= ofs(FCB);π MsDos(regs); {call Dos to delete the volume Label }π if regs.al=0 then Writeln('Success -- volume Label deleted.')π else Writeln('Failure -- volume Label not deleted.');πend; { of DelVolumeLabel }ππProcedure WriteVolumeLabel(CurrentVolumeLabel:String11);π{create volume Label from disk in current drive}πVarπ regs : Registers;π FCB : ExtendedFCBType;πbeginπ fillChar(FCB,sizeof(FCB),#0); {initialize FCB With nulls }π With FCB doπ beginπ ExtendedFCBflag:= $ff; { always }π Attr := VolumeID; {defined in the Dos Unit}π DriveID := 0; {default drive}π move(CurrentVolumeLabel[1],FileName,8);π move(CurrentVolumeLabel[9],FileExt ,3);π end; { With FCB do }ππ { set up regs For Dos call }π fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}π regs.ah:= $16; {Dos 1.0 create File Function}π regs.ds:= seg(FCB);π regs.dx:= ofs(FCB);π MsDos(regs); {call Dos to delete the volume Label }π if regs.al=0 then Writeln('Success -- volume Label written.')π else Writeln('Failure -- volume Label not written.');πend; { of WriteVolumeLabel }ππbegin { test Program }π getdir(0,oldir); { save current directory }π chdir('a:'); { play With diskette in A: }π Writeln('Old volume Label: ',GetCurrentVolumeLabel);π DelVolumeLabel(GetCurrentVolumeLabel);π WriteVolumeLabel('10987654321');π Writeln('New volume Label: ',GetCurrentVolumeLabel);π chdir(oldir); { go back to original directory }πend. { test program }π 23 05-28-9313:38ALL SWAG SUPPORT TEAM VOLABEL3.PAS IMPORT 17 ╣Oε {π>I am having difficulty changing a disk volume Label using Turbo Pascal.π>Does anyone know how to acComplish this?π}πUsesπ Dos;ππType fcbType = Recordπ drive : Byte;π name : Array[1..8] of Char;π ext : Array[1..3] of Char;π fpos : Word;π recsize : Word;π fsize : LongInt;π fdate : Word;π ftime : Word;π reserv : Array[1..8] of Byte;π currec : Byte;π relrec : LongInt;π end;π extfcb = Recordπ flag : Byte; { must be $ff! }π reserv : Array[1..5] of Byte;π attrib : Byte;π fcb : fcbType;π end;πππFunction GetVolLabel(drive:Char):String;πVar sr : SearchRec;πbeginπ findfirst(drive+':\*.*',VolumeID,sr);π if Doserror=0 then GetVolLabel:=sr.nameπ else GetVolLabel:='';πend;πππProcedure setfcbname(Var fcb:fcbType; name:String);πVar p : Byte;πbeginπ p:=pos('.',name);π if p=0 then beginπ p:=length(name)+1;π name:=name+'.';π end;π fillChar(fcb.name,11,' ');π move(name[1],fcb.name,p-1);π move(name[p+1],fcb.ext,length(name)-p);πend;πππProcedure SetVolLabel(drive:Char; vLabel:String);πVar fcb : extfcb;π vl : PathStr;π regs : Registers;π f : File;πbeginπ vl:=GetVolLabel(drive);π fcb.flag:=$ff;π fcb.attrib:=VolumeID;π if vl<>'' then beginπ setfcbname(fcb.fcb,vl);π fcb.fcb.drive:=ord(UpCase(drive))-64;π regs.ah:=$13; { Delete File }π regs.ds:=seg(fcb);π regs.dx:=ofs(fcb);π msDos(regs);π end;π if vLabel<>'' then beginπ fcb.fcb.drive:=ord(UpCase(drive))-64;π setfcbname(fcb.fcb,vLabel);π With regs do beginπ ah:=$16; { Create File }π ds:=seg(fcb);π dx:=ofs(fcb);π msDos(regs);π ah:=$10; { Close File }π ds:=seg(fcb);π dx:=ofs(fcb);π msDos(regs);π end;π end;πend;π 24 06-22-9309:16ALL SWAG SUPPORT TEAM Get Drive ID & Labels IMPORT 29 ╣J UNIT FCBLabel;π{Turbo Pascal unit for manipulating volume labels}ππINTERFACEπUSESπ DOS;πTYPEπ DriveType = String[1];π DiskIDType = String[11];ππFUNCTION GetDiskID(Drive:DriveType): DiskIDType;πFUNCTION SetDiskID(Drive:DriveType;π DiskID:DiskIDType): Boolean;πFUNCTION ReNameDiskID(Drive:DriveType;π OldDiskID:DiskIDType;π NewDiskID:DiskIDType): Boolean;πFUNCTION DeleteDiskID(Drive:DriveType): Boolean;ππIMPLEMENTATIONπTYPEπ ExtendedFCBRecord = RECORDπ ExtFCB : Byte;π Res1 : ARRAY[1..5] OF Byte;π Attr : Byte;π Drive : Byte;π Name1 : ARRAY[1..11] OF Char;π Unused1: ARRAY[1..5] OF Char;π Name2 : ARRAY[1..11] OF Char;π Unused2: ARRAY[1..9] OF Byte;π END;ππFUNCTION GetDiskID(Drive:DriveType): DiskIDType;πVARπ DirInfo : SearchRec;π DirDiskID : String[12];π I,PosPeriod : Byte;πBEGINπ FindFirst(Drive+':\'+'*.*',VolumeID,DirInfo);π IF DosError = 0 THENπ BEGINπ DirDiskID := DirInfo.Name;π PosPeriod := POS('.',DirDiskID);π IF PosPeriod > 0 THENπ Delete(DirDiskID,PosPeriod,1);π GetDiskID := DirDiskIDπ ENDπ ELSEπ GetDiskID := ''πEND;ππ{Use MsDos service 16H to SET a volume label }πFUNCTION SetDiskID(Drive:DriveType;π DiskID:DiskIDType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;π FOR I := 1 TO Length(DiskID) DOπ Name1[I] := DiskID[I];π IF Length(DiskID) < 11 THENπ FOR I := (Length(DiskID) + 1) TO 11 DOπ Name1[I] := ' 'π END;π Regs.ah := $16;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ SetDiskID := TRUEπ ELSEπ SetDiskID := FALSEπEND;ππ{use MsDOS service 17H to RENAME a volume label }πFUNCTION ReNameDiskID(Drive:DriveType;π OldDiskID:DiskIDType ;π NewDiskID:DiskIDType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;ππ {Set old disk id}ππ FOR I := 1 TO Length(OldDiskID) DOπ Name1[I] := OldDiskID[I];π FOR I := (Length(OldDiskID) + 1) TO 11 DOπ Name1[I] := ' ';ππ {Set new disk id}ππ FOR I := 1 TO Length(NewDiskID) DOπ Name2[I] := NewDiskID[I];π FOR I := (Length(NewDiskID) + 1) TO 11 DOπ Name2[I] := ' 'π END;π Regs.ah := $17;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ ReNameDiskID := TRUEπ ELSEπ ReNameDiskID := FALSEπEND;ππ{Use MsDos service 13H DELETE a volume label }ππFUNCTION DeleteDiskID(Drive:DriveType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;π Name1[1] := '*';π Name1[2] := '.';π Name1[3] := '*';π FOR I := 4 TO 11 DO Name1[I] := ' 'π END;π Regs.ah := $13;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ DeleteDiskID := TRUEπ ELSEπ DeleteDiskID := FALSEπEND;ππEND.π 25 07-16-9306:30ALL SWAG SUPPORT TEAM Edit Disk Serial Number IMPORT 30 ╣ PROGRAM Serial (Input, Output);πUSES CRT;ππCONSTπ HexDigits : ARRAY [0..15]OF CHAR = '0123456789ABCDEF';πTYPEπ InfoBuffer = RECORDπ InfoLevel : WORD; {should be zero}π Serial : LONGINT;π VolLabel : ARRAY [0..10]OF CHAR;π FileSystem : ARRAY [0..7]OF CHAR;π END;π SerString = STRING [9];ππVARπ IB : InfoBuffer;π N : WORD;π let : CHAR;π param : STRING [10];π IsSet : BOOLEAN;π NewSerial : LONGINT;π code : INTEGER;ππ FUNCTION SerialStr (L : LONGINT) : SerString;π VAR Temp : SerString;π BEGINπ Temp [0] := #9;π Temp [1] := HexDigits [L SHR 28];π Temp [2] := HexDigits [ (L SHR 24) AND $F];π Temp [3] := HexDigits [ (L SHR 20) AND $F];π Temp [4] := HexDigits [ (L SHR 16) AND $F];π Temp [5] := '-';π Temp [6] := HexDigits [ (L SHR 12) AND $F];π Temp [7] := HexDigits [ (L SHR 8) AND $F];π Temp [8] := HexDigits [ (L SHR 4) AND $F];π Temp [9] := HexDigits [L AND $F];π SerialStr := Temp;π END;ππ FUNCTION GetSerial (DiskNum : BYTE;π VAR I : InfoBuffer) : WORD;assembler;π asmπ MOV AH, 69hπ MOV AL, 00hπ MOV BL, DiskNumπ PUSH DSπ LDS DX, Iπ INT 21hπ POP DSπ JC @Badπ XOR AX, AXπ @Bad :π END;ππ FUNCTION SetSerial (DiskNum : BYTE;π VAR I : InfoBuffer) : WORD;assembler;π asmπ MOV AH, 69hπ MOV AL, 00hπ MOV BL, DiskNumπ PUSH DSπ LDS DX, Iπ INT 21hπ POP DSπ JC @Badπ XOR AX, AXπ @Bad :π END;ππ PROCEDURE ErrorOut (err : BYTE);π BEGINπ CASE err OFπ 5 : BEGINπ WRITELN ('Either the disk in ', let, ': is write',π 'protected or it lacks an extended BPB.');π WRITELN ('If the disk is not write-protected, ',π 'reformat it with DOS 4 or higher.');π END;π 15 : WRITELN ('Not a valid drive letter.');π 255 : BEGINπ WRITELN ('SYNTAX: SERIAL D:########"');π WRITELN (' where D: is the drive letter',π 'and ######## is the eight digit');π WRITELN (' hexadecimal serial number with-',π 'out the "-".');π WRITELN ('EXAMPLE: SERIAL A: 1234ABCD');π END;ππ ELSE WRITELN ('DOS ERROR #', N);π END;π HALT (1);π END;ππ BEGINπ CLRSCR;π IF PARAMCOUNT < 1 THEN ErrorOut (255);π IF PARAMCOUNT > 2 THEN ErrorOut (255);π param := PARAMSTR (1);π CASE LENGTH (param) OFπ 1 : {OK};π 2 : IF param [2] <> ':' THEN ErrorOut (255);π ELSE ErrorOut (255);π END;π let := UPCASE (param [1]);π IF (let < 'A') OR (let > 'Z') THEN ErrorOut (15);π IF PARAMCOUNT < 2 THEN IsSet := FALSEπ ELSEπ BEGINπ IsSet := TRUE;π param := '$' + PARAMSTR (2);π VAL (param, NewSerial, code);π IF code <> 0 THEN ErrorOut (255);π END;π N := GetSerial (ORD (let) - ORD ('@'), IB);π IF N = 0 THENπ BEGINπ WITH IB DOπ BEGINπ WRITELN ('Serial Number is "',π SerialStr (Serial), '"');π IF IsSet THENπ BEGINπ Serial :=π NewSerial; ;π N :=π SetSerial (ORD (let) - ORD ('@'), IB);π IF N = 0 THENππ WRITELN ('Successfully canged serial to "', SerialStr (NewSerial), '"')π ELSEπ ErrorOut (N);π END;π END;π ENDπ ELSE ErrorOut (N);ππ END.ππ 26 07-17-9307:29ALL LAWRENCE JOHNSTONE Disk Serial Numbers IMPORT 15 ╣ (*πDate: 07-10-93 (02:15)πFrom: LAWRENCE JOHNSTONEπSubj: DISK'S SERIAL NUMBER.πThis will work under DOS 4.0 or later, according to Microsoft's MS-DOSπProgrammer's Reference (earlier versions of DOS didn't give disksπserial numbers).π*)ππUNIT MediaID;ππINTERFACEππTYPEπ TMediaID = RECORDπ InfoLvl: WORD;π SerialNum: LONGINT;π VolLabel: ARRAY [1..11] OF CHAR;π FileSys: ARRAY [1..8] OF CHAR;π END;ππFUNCTION GetMediaID( Drive: WORD; VAR MID: TMediaID ): BOOLEAN;π (* Drive: 0=default, 1=A, 2=B, etc. *)ππFUNCTION SetMediaID( Drive: WORD; CONST MID: TMediaID ): BOOLEAN;ππIMPLEMENTATIONππFUNCTION GetMediaID( Drive: WORD; VAR MID: TMediaID ): BOOLEAN; ASSEMBLER;π ASMπ push dsπ mov bx, [Drive]π mov ch, $08 (* Device category (must be 08h) *)π mov cl, $66 (* Minor code for Get Media ID function *)π lds dx, [MID] (* DS:DX -> TMediaID structure *)π mov ax, $440D (* Function 44 (IOCTL), subfunction 0D *)π int $21π pop dsπ mov ax, 0 (* Assume function failed *)π jc @@Doneπ inc ax (* Didn't fail -- return TRUE *)π @@Done:π END;ππFUNCTION SetMediaID( Drive: WORD; CONST MID: TMediaID ): BOOLEAN; ASSEMBLER;π ASMπ push dsπ mov bx, [Drive]π mov ch, $08 (* Device category (must be 08h) *)π mov cl, $46 (* Minor code for Set Media ID function *)π lds dx, [MID] (* DS:DX -> TMediaID structure *)π mov ax, $440D (* Function 44 (IOCTL), subfunction 0D *)π int $21π pop dsπ mov ax, 0 (* Assume function failed *)π jc @@Doneπ inc ax (* Didn't fail -- return TRUE *)π @@Done:π END;πππEND.ππ 27 08-17-9308:42ALL SWAG SUPPORT TEAM FCBLABELS - Disk Serial IMPORT 51 ╣ UNIT FCBLabel;π{Turbo Pascal unit for manipulating volume labels}ππINTERFACEπUSESπ DOS;πTYPEπ DriveType = String[1];π DiskIDType = String[11];ππFUNCTION GetDiskID(Drive:DriveType): DiskIDType;πFUNCTION SetDiskID(Drive:DriveType;π DiskID:DiskIDType): Boolean;πFUNCTION ReNameDiskID(Drive:DriveType;π OldDiskID:DiskIDType;π NewDiskID:DiskIDType): Boolean;πFUNCTION DeleteDiskID(Drive:DriveType): Boolean;ππIMPLEMENTATIONπTYPEπ ExtendedFCBRecord = RECORDπ ExtFCB : Byte;π Res1 : ARRAY[1..5] OF Byte;π Attr : Byte;π Drive : Byte;π Name1 : ARRAY[1..11] OF Char;π Unused1: ARRAY[1..5] OF Char;π Name2 : ARRAY[1..11] OF Char;π Unused2: ARRAY[1..9] OF Byte;π END;ππFUNCTION GetDiskID(Drive:DriveType): DiskIDType;πVARπ DirInfo : SearchRec;π DirDiskID : String[12];π I,PosPeriod : Byte;πBEGINπ FindFirst(Drive+':\'+'*.*',VolumeID,DirInfo);π IF DosError = 0 THENπ BEGINπ DirDiskID := DirInfo.Name;π PosPeriod := POS('.',DirDiskID);π IF PosPeriod > 0 THENπ Delete(DirDiskID,PosPeriod,1);π GetDiskID := DirDiskIDπ ENDπ ELSEπ GetDiskID := ''πEND;ππ{Use MsDos service 16H to SET a volume label }πFUNCTION SetDiskID(Drive:DriveType;π DiskID:DiskIDType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;π FOR I := 1 TO Length(DiskID) DOπ Name1[I] := DiskID[I];π IF Length(DiskID) < 11 THENπ FOR I := (Length(DiskID) + 1) TO 11 DOπ Name1[I] := ' 'π END;π Regs.ah := $16;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ SetDiskID := TRUEπ ELSEπ SetDiskID := FALSEπEND;ππ{use MsDOS service 17H to RENAME a volume label }πFUNCTION ReNameDiskID(Drive:DriveType;π OldDiskID:DiskIDType ;π NewDiskID:DiskIDType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;ππ {Set old disk id}ππ FOR I := 1 TO Length(OldDiskID) DOπ Name1[I] := OldDiskID[I];π FOR I := (Length(OldDiskID) + 1) TO 11 DOπ Name1[I] := ' ';ππ {Set new disk id}ππ FOR I := 1 TO Length(NewDiskID) DOπ Name2[I] := NewDiskID[I];π FOR I := (Length(NewDiskID) + 1) TO 11 DOπ Name2[I] := ' 'π END;π Regs.ah := $17;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ ReNameDiskID := TRUEπ ELSEπ ReNameDiskID := FALSEπEND;ππ{Use MsDos service 13H DELETE a volume label }ππFUNCTION DeleteDiskID(Drive:DriveType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;π Name1[1] := '*';π Name1[2] := '.';π Name1[3] := '*';π FOR I := 4 TO 11 DO Name1[I] := ' 'π END;π Regs.ah := $13;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ DeleteDiskID := TRUEπ ELSEπ DeleteDiskID := FALSEπEND;ππEND.ππ{ --------------- TEST PROGRAM -------------------}πππPROGRAM TestFCB;ππ{ test FCBLabel UNIT}ππUSES CRT,FCBLabel;ππVARπ Choice : Byte;π Drive : DriveType;π DiskID : DiskIDType;π NewDiskID : DiskIDType;ππBEGINπ REPEAT {Endless loop - select option 5 to Exit}π ClrScr;π GotoXY(25,1); WriteLn('Volume Functions');π GotoXY(25,9); WriteLn('1) SET LABEL');π GotoXY(25,10); WriteLn('2) DELETE LABEL');π GotoXY(25,11); WriteLn('3) RENAME LABEL');π GotoXY(25,12); WriteLn('4) GET LABEL');π GotoXY(25,13); WriteLn('5) Exit');π GotoXY(20,15);π Write('Type number and press Enter > ');π ReadLn(Choice); WriteLn;π Drive := 'C'; { use drive C: as test drive }ππ CASE Choice OFπ 1: BEGIN {Set volume LABEL}π DiskID := GetDiskID(Drive);π IF DiskID <> '' THENπ BEGINπ WriteLn('Label not null: ',DiskID);π WriteLn('Use RENAME instead');π WriteLn('Press Enter to continue');π ReadLnπ ENDπ ELSEπ BEGINπ Write('Enter new label > ');π ReadLn(DiskID);π IF NOT SetDiskID(Drive,DiskID) THENπ BEGINπ WriteLn('System Error');π WriteLnπ ('Press Enter to continue');π ReadLnπ ENDπ ENDπ END;π 2: BEGIN {Delete Volume LABEL}π IF DeleteDiskID(Drive) THENπ WriteLn('Volume label deleted')π ELSEπ WriteLn('System Error');π WriteLn('Press Enter to continue');π ReadLnπ END;π 3: BEGIN {Rename Volume LABEL}π DiskID := GetDiskID(Drive);π IF DiskID = '' THENπ BEGINπ WriteLn('Current label is null:');π WriteLn('Use SET option instead');π WriteLn('Press Enter to continue');π ReadLnπ ENDπ ELSEπ BEGINπ Write('Enter new name of label > ');π ReadLn(NewDiskID);π IF NOT ReNameDiskIDπ (Drive,DiskID,NewDiskID) THENπ BEGINπ WriteLn('System Error');π WriteLnπ ('Press Enter to continue');π ReadLnπ ENDπ ENDπ END;π 4: BEGIN {Get Volume LABEL}π DiskID := GetDiskID(Drive);π Write('The current label is ');π IF DiskID = '' THENπ WriteLn('null')π ELSEπ WriteLn(DiskID);π WriteLn('Press Enter to continue');π ReadLnπ END;π 5: Halt;π ELSE { continue }π END { case }π UNTIL FALSEπEND.π 28 08-17-9308:47ALL JAN DOGGEN Disk Parking IMPORT 19 ╣ ===========================================================================π BBS: Canada Remote SystemsπDate: 07-11-93 (20:49) Number: 30503πFrom: JAN DOGGEN Refer#: NONEπ To: MARK STEPHEN Recvd: NO πSubj: RE: PARK IT! Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Mark Stephen to Herb Brown <=-ππ HB> Anybody have any suggestions, experiences, trials, tribulations,π HB> videos, and/or code examples on how to park a hard drive?ππ MS> Trouble is, I have no idea of how to find out if the code has actuallyπ MS> done what I want it to, and there seems to be a real possibility ofππ Yep, took me some time to figure out you can't test where the head isπ (i.e. if the park was succesful).π I always assume that it won't do any harm on self-parking drivesπ (they just park twice).π Here's some code for Herb too; I guess he reads this too.ππPROCEDURE ParkDisk;π VAR Regs: Registers;π BEGINπ Regs.AH := $08; { 'Return drive parameters' function }π Regs.DL := $80; { Physical drive number - first hard disk }π Regs.AL := $00;π Intr($13,Regs);π Assert((Regs.Flags AND FCarry) = 0,π 'Error getting disk parameters - AL returns '+IntToStr(Regs.AL,0));π { Now: DL = Number of drives responding }π { DH = Maximum head number (# heads - 1) }π { CH = Maximum cylinders/tracks (# tracks - 1) - lower 8 bits }π { CL = Higher 2 bits: high 2 bits of max cyl/tr }π { Lower 6 bits: Maximum sector number }π { We now position the heads using the BIOS Seek service. We can use }π { the returned registers again if we set DL back to $80. }π Regs.AH := $0C;π Regs.DL := $80;π Intr($13,Regs);π Assert((Regs.Flags AND FCarry) = 0,π 'Error parking disk - AL returns '+IntToStr(Regs.AL,0));π END; { ParkDisk }ππ MS> How about ignoring the problem, and if trouble develops, blaming it onπ MS> the hardware? (I believe this is the traditional approach?) The codeππ Some approach!ππ Janπ___ Blue Wave/QWK v2.10ππ--- Maximus 2.01π * Origin: *** DOSBoss Zuid *** (2:500/131)π 29 08-18-9312:20ALL JOSE ALMEIDA Get Device Type IMPORT 15 ╣ { Gets the device type.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππPROCEDURE dpDevType(Drive : byte;π var Device_Type : byte;π var Error_Code : byte);ππ{ DESCRIPTION:π Gets the device type.π SAMPLE CALL:π dpDevType(1,Device_Type,Error_Code);π ON ENTRY:π Drive:π 1 : drive A:π 2 : drive B:π and so on...π RETURNS:π Device_Type :π 0 : 320/360 KBytes floppyπ 1 : 1.2 MBytes floppyπ 2 : 720 KBytes floppyπ 3 : 8" single density floppyπ 4 : 8" double density floppyπ 5 : hard diskπ 6 : tape driveπ 7 : 1.44 MBytes floppyπ 8 : read/write optiocal diskπ 9 : 2.88 MBytes floppyπ else : unknown device typeπ Error_Code:π 0 : no errorπ else : error number (see The PC Programmers Source Book 3.191)π NOTES:π Applies to all DOS versions beginning with v3.3.π See dpDevType_Text() in order to get a string text. }ππvarπ TmpA : array[0..31] of byte;π HTregs : registers;ππBEGIN { dpDevType }π HTregs.AX := $440D;π HTregs.BX := word(Drive);π HTregs.CX := $0860;π HTregs.DX := Ofs(TmpA);π HTregs.DS := Seg(TmpA);π MsDos(HTregs);π if HTregs.Flags and FCarry <> 0 thenπ beginπ Device_Type := $FF; { on error returns unknown device type }π Error_Code := HTregs.ALπ endπ elseπ beginπ Device_Type := TmpA[1];π Error_Code := 0;π end;πEND; { dpDevType }π 30 08-18-9312:23ALL JOSE ALMEIDA Check for diskettes IMPORT 8 ╣ { Cheks if there are diskettes drives present.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Diskettes_Present : boolean;π{ DESCRIPTION:π Cheks if there are diskettes drives present.π SAMPLE CALL:π B := Diskettes_Present;π RETURNS:π TRUE : There are diskettes drivesπ FALSE : There aren't diskettes drives }ππBEGIN { Diskettes_Present }π Diskettes_Present := (MemW[$0000:0410] and $0001) <> 0;πEND; { Diskettes_Present }π 31 08-18-9312:23ALL JOSE ALMEIDA Get number of fixed disksIMPORT 7 ╣ { Gets the number of fixed disks attached to the system.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Fixed_Disks : byte;π{ DESCRIPTION:π Gets the number of fixed disks attached to the system.π SAMPLE CALL:π NB := Fixed_Disks;π RETURNS:π The numbers of fixed disks attached to the system. }ππBEGIN { Fixed_Disks }π Fixed_Disks := Mem[$0000:$0475];πEND; { Fixed_Disks }π 32 08-18-9312:24ALL JOSE ALMEIDA Get first CD-ROM Drive IMPORT 8 ╣ { Gets the first installed CD-ROM drive letter in a system.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION First_CD_ROM_Drive : byte;π{ DESCRIPTION:π Gets the first installed CD-ROM drive letter in a system.π SAMPLE CALL:π NB := First_CD_ROM_Drive;π RETURNS:π 0 : drive Aπ 1 : drive Bπ and so on... }ππvarπ HTregs : registers;ππBEGIN { First_CD_ROM_Drive }π HTregs.AX := $1500;π HTregs.BX := $0000;π Intr($2F,HTregs);π First_CD_ROM_Drive := HTregs.CL;πEND; { First_CD_ROM_Drive }π 33 08-18-9312:24ALL JOSE ALMEIDA Get Number of CD-ROMS IMPORT 8 ╣ { Gets the number of installed CD-ROM drives in a system.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION CD_ROM_Units : byte;ππ{ DESCRIPTION:π Gets the number of installed CD-ROM drives in a system.π SAMPLE CALL:π NB := CD_ROM_Units;π RETURNS:π 0 : driver not installedπ else : number of CD-ROM units }ππvarπ HTregs : registers;ππBEGIN { CD_ROM_Units }π HTregs.AX := $1500;π HTregs.BX := $0000;π Intr($2F,HTregs);π CD_ROM_Units := HTregs.BL;πEND; { CD_ROM_Units }π 34 08-18-9312:25ALL JOSE ALMEIDA Get Current Drive Number IMPORT 7 ╣ { Gets the current drive number.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Get_Default_Drive : byte;π{ DESCRIPTION:π Gets the current drive number.π SAMPLE CALL:π NB := Get_Default_Drive;π RETURNS:π A = 0, B = 1, C = 2, etc. }ππvarπ HTregs : registers;ππBEGIN { Get_Default_Drive }π HTregs.AH := $19;π MsDos(HTregs);π Get_Default_Drive := HTregs.ALπEND; { Get_Default_Drive }π 35 08-18-9312:26ALL JOSE ALMEIDA Get Installed diskettes IMPORT 8 ╣ { Gets the number of installed diskette drives in a system.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Installed_Diskettes : byte;π{ DESCRIPTION:π Gets the number of installed diskette drives in a system.π SAMPLE CALL:π NB := Installed_Diskettes;π RETURNS:π The number of installed diskette drives. }ππBEGIN { Installed_Diskettes }π Installed_Diskettes := Succ((MemW[$0000:0410] shl 8) shr 14);πEND; { Installed_Diskettes }π 36 08-18-9312:26ALL JOSE ALMEIDA Get the BOOT Drive IMPORT 7 ╣ { Gets the startup (boot) drive.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Startup_Drive : byte;π{ DESCRIPTION:π Gets the startup (boot) drive.π SAMPLE CALL:π NB := Startup_Drive;π RETURNS:π 1 : drive Aπ 2 : drive Bπ and so on... }ππvarπ HTregs : registers;ππBEGIN { Startup_Drive }π HTregs.AX := $3305;π MsDos(HTregs);π Startup_Drive := HTregs.DL;πEND; { Startup_Drive }π 37 08-18-9312:26ALL JOSE ALMEIDA Get Current Drive Number IMPORT 7 ╣ { Sets the current drive number.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππPROCEDURE Set_Default_Drive(D : byte);π{ DESCRIPTION:π Sets the current drive number.π SAMPLE CALL:π Set_Default_Drive(1);π RETURNS:π Nothing.π NOTES:π A = 0, B = 1, C = 2, etc. }ππvarπ HTregs : registers;ππBEGIN { Set_Default_Drive }π HTregs.AH := $0E;π HTregs.DL := D;π MsDos(HTregs);πEND; { Set_Default_Drive }π 38 08-18-9312:26ALL JOSE ALMEIDA Get Disk Verify State IMPORT 7 ╣ { Gets disk verify state flag.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Verify_State : boolean;π{ DESCRIPTION:π Gets disk verify state flag.π SAMPLE CALL:π B := Verify_State;π RETURNS:π TRUE = on: verify after writeπ FALSE = off: no verify after write }ππvarπ HTregs : registers;ππBEGIN { Verify_State }π HTregs.AH := $54;π MsDos(HTregs);π Verify_State := HTregs.AL = $01;πEND; { Verify_State }π 39 08-23-9309:17ALL MARTIN RICHARDSON Valid Drives Function IMPORT 21 ╣ (*π===========================================================================π BBS: Beta ConnectionπDate: 08-08-93 (11:19) Number: 2152πFrom: MARTIN RICHARDSON Refer#: NONEπ To: ALL Recvd: NOπSubj: VALID DRIVES FUNCTION Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------πThanks for the help I got with my @Result question. Using the resposes,πI have fixed the routine. Here is the result, a clean way to find allπvalid drives w/o having to do any kind of disk access:π}π{*****************************************************************************π * Function ...... Drivesπ * Purpose ....... To return a string containing the valid drives for theπ * current system.π * Parameters .... Noneπ * Returns ....... A string of the valid drives.π * Notes ......... Noneπ * Copyright ..... None. This routine is public domain.π * Author ........ Martin Richardsonπ * Date .......... March 3, 1993π * August 6, 1993 (fix)π *****************************************************************************}π*)ππUSES CRT;ππFUNCTION Drives: STRING;πVARπ DriveInfo: ARRAY[1..2] OF CHAR;π Buffer: ARRAY[1..40] OF CHAR;π DriveString: ARRAY[1..25] OF CHAR;πBEGIN ASMπ PUSH SIπ PUSH DIπ PUSH ESπ PUSH DSππ MOV SI, SSπ MOV DS, SIπ MOV SI, OFFSET DriveInfoπ PUSH DSπ POP ESπ MOV DI, OFFSET Bufferπ MOV BX, OFFSET DriveStringππ MOV BYTE PTR [SI], '#'π XOR CX, CXππ@1:π INC BYTE PTR [SI] { Next Letter }π MOV BYTE PTR [SI+1], ':'π MOV AX, $2906π INT 21hππ MOV SI, OFFSET DriveInfoπ CMP AL, $FFπ JE @2ππ INC CXπ PUSH CXπ MOV CL, BYTE PTR DS:[SI]π MOV [BX], CLπ INC BXπ POP CXππ@2:π CMP BYTE PTR [SI], 'Z'π JNE @1ππ MOV SI, OFFSET DriveStringπ LES DI, @Resultπ INC DIπ REP MOVSBππ XCHG AX, DIπ MOV DI, WORD PTR @Resultπ SUB AX, DIπ DEC AXπ STOSBππ POP DSπ POP ESπ POP DIπ POP SIπEND; END;ππBEGINπClrScr;πWriteLn(DRives);πReadkey;πEND.ππI have not yet gotten this to bomb. If anyone does, PLEASE LET ME KNOW!ππ-Martinππ * SLMR 2.1a * And then the Nun said "No, give me the bannanna!"π---π * deltaComm Online 919-481-9399 - 10 linesπ * PostLink(tm) v1.06 DELTA (#22) : RelayNet(tm) HUBπ 40 08-27-9320:16ALL BO BENDTSEN Getting BIG Drive Size IMPORT 11 ╣ {πBO BENDTSENππMany people don't think about it, but DOS is limited to report more thanπ1 gigabyte. I have a 1.3 and a 1.0 gig, and made these routines for myπprograms for knowing if the drive size is more than 1 gig. Using the normalπDiskSize and DiskFree could get you strange result, sometimes it could reportπmaybe 100MB when it is really 1 gig.ππIf the size of free space is 1 you can assume that the drive is more than 1πgigabyte.π}ππFunction DriveSize(d : byte) : Longint; { -1 not found, 1=>1 Giga }πVarπ R : Registers;πBeginπ With R Doπ Beginπ ah := $36;π dl := d;π Intr($21, R);π If AX = $FFFF Thenπ DriveSize := -1 { Drive not found }π Elseπ If (DX = $FFFF) or (Longint(ax) * cx * dx = 1073725440) Thenπ DriveSize := 1π Elseπ DriveSize := Longint(ax) * cx * dx;π End;πEnd;ππFunction DriveFree(d : byte) : Longint; { -1 not found, 1=>1 Giga }πVarπ R : Registers;πBeginπ With R Doπ Beginπ ah := $36;π dl := d;π Intr($21, R);π If AX = $FFFF Thenπ DriveFree := -1 { Drive not found }π Elseπ If (BX = $FFFF) or (Longint(ax) * bx * cx = 1073725440) Thenπ DriveFree := 1π Elseπ DriveFree := Longint(ax) * bx * cx;π End;πEnd;π 41 08-27-9320:50ALL ROB GREEN Last Drive IMPORT 6 ╣ {πROB GREENππ> do any of you guys know how to figure out which drive is the last driveπ> on someone's system? I was think of making a drive With Dos'sπ}ππUsesπ Dos;ππFunction driveexist(ch : Char) : Boolean;πbeginπ DriveExist := disksize(ord(upcase(ch)) - 64) <> - 1;πend;πππ{ Kerry Sokalsky }ππConstπ exist : Boolean = True;π ch : Integer = 67; { 'C' - Skip floppy Drives (A&B) }π lastdrive : Char = ' ';ππbeginπ While LastDrive = ' ' doπ beginπ if driveexist(Chr(ch)) thenπ Inc(Ch)π elseπ LastDrive := Chr(Ch - 1);π end;ππ Writeln(LastDrive);πend.ππ 42 08-27-9321:57ALL PETER KLAPPROTH Disk Serial Numbers IMPORT 9 ╣ {πPETER KLAPPROTHππ> If anyone happens to know how to find the serial numberπ> of a diskette, please let me know, code is nice :)π> It is stored in byte 42, 41, 40, and 39 (counting the first one asπ> 0) of ths first sector of the disk. The code I have for it uses theπ> TPro package to read the sector.ππannother way to read/write the diskId is the following small peace of code.π}ππtypeπ TInfoBuffer = recordπ InfoLevel : word; {may be 0}π Serial : longInt;π VolLabel : array [0..10] of char;π FileSystem: array [0..7] of char;π end;ππfunction GetSerial(DiskNum : Byte; var I : TInfoBuffer) : word; assembler;πasmπ mov ah, 69hπ mov al, 00hπ mov bl, DiskNumπ push dsπ lds dx, Iπ int 21hπ pop dsπ jc @badπ Xor ax, axπ @bad:πend;ππfunction SetSerial(DiskNum : Byte; var I : TInfoBuffer) : word; assembler;πasmπ mov ah, 69hπ mov al, 01hπ mov bl, DiskNumπ push dsπ lds dx, Iπ int 21hπ pop dsπ jc @badπ xor ax, axπ @bad:πend;ππ 43 10-28-9311:30ALL BRAIN PAPE Is DISK Ready ?? SWAG9311 25 ╣ {===========================================================================πDate: 10-03-93 (00:14)πFrom: BRIAN PAPEπSubj: disk readyπ---------------------------------------------------------------------------πDoes anyone know if there is any better (and FASTER!) way to tell if aπdisk drive is ready? I wrote a function yesterday to do that by callingπthe BIOS Read Track interrupt. The only problem is that it has toπactually read from the disk, and it is rather slow, especially on slowerπcomputers.ππHere is my code: }ππ{ NOTE :ππ Added a BOOLEAN function and added Reset DRIVE GDAVIS 10/15/93}ππUSES CRT;ππVARπ Buf : ARRAY[0..512] OF BYTE; { Buffer MUST be outside }ππfunction diskstatus(drive:byte):byte; assembler; { drive is A=0, B=1 etc}πasmπ cmp drive,26π jb @driveokπ mov drive,0 { if drive isn't between 0 and 25, make it 0 (for A:) }π @driveok:ππ mov ax, seg bufπ mov es, axπ mov bx, offset bufππ mov ah, 02 { read disk sectors }π mov al, 1 { number of sectors to transfer }π mov ch, 1 { track number }π mov cl, 1 { sector number }π mov dh, 1 { head number }π mov dl, drive { drive number (0=A, 3=C, or 80h=C, 81h=D) }π int 13hππ mov bl,0 { assume drive is ready }π jnc @done { carry set if unsuccessfull (i.e. disk is not ready) }π mov bl,ahπ jmp @doneππ { take out the above two lines to make this just checkπ for disk ready/not ready }ππ and ah,$80π jz @done { error was something other than disk not ready }π mov bl,false{ disk wasn't ready. store result }π @done:ππ mov ax,$0000 { reset drive }π INT 13Hππ xor ax,ax { shut off disk drive quickly }π mov es,axπ mov ax,440hπ mov di,axπ mov byte ptr es:[di],01hππ mov al,bl { retrieve result }πend; { diskstatus }πππfunction diskready(drive:CHAR):BOOLEAN; assembler;πasmπ cmp drive,'a'π jb @isupcase { make it UPPER case }π sub drive,20Hπ @isupcase:π cmp drive,'Z'π jb @driveokπ mov drive,'A' { if drive isn't between 'A' and 'Z', make it A) }π @driveok:π mov ax, seg bufπ mov es, axπ mov bx, offset bufππ mov ah, 02 { read disk sectors }π mov al, 1 { number of sectors to transfer }π mov ch, 1 { track number }π mov cl, 1 { sector number }π mov dh, 1 { head number }ππ mov dl, driveπ sub dl, 'A' { subtract ORD of 'A' }ππ {mov dl, drive { drive number (0=A, 3=C, or 80h=C, 81h=D) }π int 13hππ mov bl,true { assume drive is ready }π and ah,$80π jz @done { error was something other than disk not ready }π mov bl,false{ disk wasn't ready. store result }π @done:ππ mov ax,$0000 { reset drive }π INT 13Hππ xor ax,ax { shut off disk drive quickly }π mov es,axπ mov ax,440hπ mov di,axπ mov byte ptr es:[di],01hππ mov al,bl { retrieve result }πend; { diskready }ππBEGINπClrScr;πWriteLn(DiskStatus(0));πWriteLn(DiskReady('a')); { case ain't significant }πreadkey;πEND. 44 09-26-9310:11ALL CHRIS PRIEDE Hard Drive Report SWAG9311 18 ╣ (*π===========================================================================π BBS: Canada Remote SystemsπDate: 09-20-93 (01:47) Number: 8840πFrom: CHRIS PRIEDE Refer#: NONEπ To: WIM VAN.VOLLENHOVEN Recvd: NOπSubj: Disk & Drives Conf: (1617) L-Pascalπ---------------------------------------------------------------------------πWV> - I can't figure out how to determain if the drive is a ramdiskπWV> or a fixed disk.ππ RAM disks have only one copy of FAT, while floppies and hard disksπshould have at least two. Use DOS function 1Fh or 32h to get thisπinformation for current/specified drive. The following program usesπfunction 1F:ππ===========================================================π*)ππprogram TellMeAllAboutMyDrive;π(* Released to public domain, K. Priede, 1993 *)ππuses Dos;ππtypeπ (* record matching DOS (2.0+) Drive Parameter Block.π * defined only interesting items, DOS structure is bigger *)π DosDPB = recordπ Drive, UnitNo: byte;π BytesPerSector: word;π LastSectorInCluster: byte;π ShiftCount: byte;π ReservedSectors: word;π FATCount: byte;π RootDirEntries, FirstDataSector, LastCluster: word;π end;ππvarπ Regs: Registers;ππbeginπ (* func. 1Fh -- Get DPBπ * returns: AL = 0 if successful, DS:BX -> DBP *)π Regs.AH := $1F;π MsDos(Regs);π (* now show what we got ... *)π if Regs.AL = 0 thenπ with DosDPB(Ptr(Regs.DS, Regs.BX)^) doπ beginπ Writeln(#10#13'Parameters for drive ',π Chr(Ord('A') + Drive), ':'#13#10);π Writeln('Sector size: ':24, BytesPerSector, ' bytes');π Writeln('Sectors per cluster: ':24, LastSectorInCluster +1);π Writeln('Clusters on drive: ':24, LastCluster -1);π Writeln('Total drive space: ':24, longint(BytesPerSector) *π (LastSectorInCluster +1) * (LastCluster -1),' bytes'#13#10);π Writeln('Number of FATs: ':24, FATCount);π Writeln('Root directory size: ':24, RootDirEntries, ' entries');π endπ else Writeln('Error!');πend.π===========================================================π---π ■ RNET 2.00m: ILink: Faster-Than-Light ■ Atlanta GA ■ 404-296-3120 / 299-3930π 45 10-28-9311:30ALL D.J. MURDOCK DISK Light SWAG9311 8 ╣ (*π=========================================================================πDate: 10-02-93 (19:15)πFrom: D.J. MurdochπSubj: Flashing The Disk Lightπ=========================================================================ππTHIS IS SAFE !!!! All it does is turn the disk light ON/OFF. Shouldπonly be used on Floppy drives.ππ*)ππUSES Crt;ππprocedure turn_on_motor(drive:byte);π{ Remember to wait about a half second before trying to read! }πbeginπ port[$3F2] := 12 + drive + 1 SHL (4 + drive);πend;ππprocedure turn_off_motor(drive:byte);π{ drive A = 0, drive B = 1 }πbeginπ port[$3F2] := 12 + drive;πend;ππVAR I : BYTE;ππBEGINππFOR I := 1 TO 10 DO { let's make 'A' and 'B' flash for awhile }π BEGInπ Turn_On_Motor(0);π Delay(100);π Turn_Off_Motor(0);π Delay(100);π Turn_On_Motor(1);π Delay(100);π Turn_Off_Motor(1);π Delay(100);π END;πEND.ππ 46 11-02-9306:11ALL DESCLIN JEAN Detecting RAM Disks SWAG9311 34 ╣ {πDesclin Jean <desclinj@ulb.ac.be>ππ a few days ago (sorry, I didn't write down the name of the personπ who posted the question :-(), someone asked how one couldπ identify a drive as a ramdisk.π Below is a solution, which I submit with the hope that someoneπ else could show how to improve on it, since it is not 'fail-safe'.π Here it comes...ππModified after Michael Tischer: Turbo Pascal 6 System ProgrammingπABACUS Publisher Grand Rapids, MI 49512 1991 ISBN 1-55755-124-3πI had to write the procedure Getdrives twice in order to take intoπaccount the changes in the DPB structure which occurred from DOSπ4.0 onwards. Mostly, Ramdisks have only one File Allocation Table,πwhereas other drive types have two. That's what a procedure suchπas GetDiskClass of TurboPower Object Professional (usual disclaimerπhere ;-)) uses to decide whether the drive is a ramdisk or not. BUTπBEWARE! This is not necessarily so! Norton mentions, in his 'diskπcompanion', that depending on the device driver of the ramdisk, oneπor two FATS may be implemented. I could verify this on 'STACKED'πramdisks: they have two FATS, whereas only one FAT is present afterπ'unSTACKING' :-(. Thus, the solution below is somewhat shaky.π}πππprogram idramdsk;πusesπ Dos;ππvarπ ver : byte;ππprocedure GetDrives1;πtypeπ DPBPTR = ^DPB; { pointer to a DOS Parameter Block }π DPBPTRPTR = ^DPBPTR; { pointer to a pointer to a DPB }π DPB = record { recreation of a DOS Parameter Block }π Code : byte; { drive code (0=A, 1=B etc. }π dummy1 : array [1..$07] of byte;{irrelevant bytes}π FatNb : byte; {Number of File Allocation Tables }π dummy2 : array [9..$17] of byte;{irrelevant bytes}π Next : DPBPTR; { pointer to next DPB }π end; { xxxx:FFFF marks last DPB }ππvarπ Regs : Registers; { register for interrupt call }π CurrDpbP : DPBPTR; { pointer to DPBs in memory }ππbeginπ {-- get pointer to first DPB ------------------------------------}π Regs.AH := $52; {function $52 returns ptr to DOS Information Block }π MsDos(Regs); {that's an UNDOCUMENTED DOS function ! }π CurrDpbP := DPBPTRPTR(ptr(Regs.ES, Regs.BX))^;ππ {-- follow the chain of DPBs--------------------------------------}π repeatπ writeln(chr(ord('A') + CurrDpbP^.Code), {display device code }π ':(FATS: ', CurrDpbP^.FatNb,')'); {and number of FATs }ππ CurrDpbP := CurrDpbP^.Next; { set pointer to next DPB }π until (Ofs(CurrDpbP^) = $FFFF); { until last DPB is reached }πend;ππprocedure GetDrives2;πtypeπ DPBPTR = ^DPB; { pointer to a DOS Parameter Block }π DPBPTRPTR = ^DPBPTR; { pointer to a pointer to a DPB }π DPB = record { recreation of a DOS Parameter Block }π Code : byte; { drive code (0=A, 1=B etc. }π dummy1 : array [1..$07] of byte;{irrelevant bytes}π FatNb : byte; { Number of File Allocation Tables}π dummy2 : array [9..$18] of byte;{irrelevant bytes}π Next : DPBPTR; { pointer to next DPB }π end; { xxxx:FFFF marks last DPB }ππvarπ Regs : Registers; { register for interrupt call }π CurrDpbP : DPBPTR; { pointer to DPBs in memory }ππbeginπ {-- get pointer to first DPB-------------------------------------}π Regs.AH := $52; {function $52 returns ptr to Dos Information Block }π MsDos(Regs); {that's an UNDOCUMENTED DOS function ! }π CurrDpbP := DPBPTRPTR(ptr(Regs.ES, Regs.BX))^;ππ {-- follow the chain of DPBs -------------------------------------}π repeatπ {output device letter and number of FATs (1 for RAM disks) }π writeln(chr(ord('A') + CurrDpbP^.Code), ':(FATS: ', CurrDpbP^.FatNb, ')');π CurrDpbP := CurrDpbP^.Next; { set pointer to next DPB }π until (Ofs(CurrDpbP^) = $FFFF); { until last DPB is reached }πend;ππbeginπ ver := Lo(DosVersion);π writeln(#13#10'Installed drives: '#13#10);π if ver < 4 thenπ GetDrives1π elseπ GetDrives2πend.ππ 47 11-02-9305:34ALL ERIC GIVLER Getting Drive INFO SWAG9311 10 ╣ {πERIC GIVLERππ> about, evidentally), are two different things. The serialπ> number is only accessible in Dos v4.0+, and (I think), youπ> have to use the FCBs to get it.ππNo, no FCBs, see:π}ππUsesπ Dos,π Crt;ππTypeπ MIDRecord = Recordπ InfoLevel : Word;π SerialNum : LongInt; {This is the serial number...}π VolLabel : Array [1..11] of Char;π FatType : Array [1..8] of Char;π end;ππFunction Label_Fat(Var Mid : MidRecord; Drive : Word) : Boolean;πVarπ Result : Word;π Regs : Registers;πbeginπ FillChar(Mid,SizeOf(Mid),0);π FillChar(Regs,SizeOf(Regs),0);π With Regs DOπ beginπ AX := $440D;π BX := Drive;π CX := $0866;π DS := Seg(Mid);π DX := Ofs(Mid);π Intr($21,Regs);π Case AX ofπ $01 : Label_Fat := False;π $02 : Label_Fat := False;π $05 : Label_Fat := False;π elseπ Label_Fat := True;π end;π end;πend;ππVarπ Mid : MidRecord;πbeginπ ClrScr;π if Label_Fat(Mid,0) Thenπ With Mid DOπ beginπ Writeln(SerialNum);π Writeln(VolLabel);π Writeln(FatType);π endπ elseπ Writeln('Error Occured');πend.ππ 48 10-28-9311:30ALL GAYLE DAVIS EXISTDD Update SWAG9311 31 ╣ { Updated DRIVES.SWG on October 13, 1993 }ππ{ This give all the info on a bootable drive }π{ it replaces the EXIST-DD in DRIVES.SWG which DID NOT work }π{ updated by GDAVIS 10/13/93 }ππUsesπ Crt,Dos;ππTypeπ bootrecptr = ^bootRecord;π bootRecord = Recordπ nj : Array[0..2] of Byte; {offset 0 Near jump code }π oem : Array[0..7] of Byte; { 3 OEM name and ver }π Bytesec : Word; { 11 Bytes/Sector }π sectclus : Byte; { 13 Sectors/cluster }π ressect : Word; { 14 Reserved sectors }π fattables: Byte; { 16 FAT tables }π direntrys: Word; { 17 Directory entries}π logsec : Word; { 19 Logical sectors }π MDS : Byte; { 21 Media descriptor }π FatSects : Word; { 22 FAT sectors }π Secstrak : Word; { 24 Sectors/track }π NumHeads : Word; { 26 Number of heads }π HidnSecs : Word; { 28 Hidden sectors }π bootcode : Array[0..415] of Byte; { 30 boot code }π partcode : Array[0..15] of Byte; { 446 partition info }π bootcode2: Array[0..49] of Byte; { 462 rest of boot code}π end;ππVarπ boot : bootRecord; { the boot Record Variable }ππ FUNCTION DiskRead (Drive : CHAR; SSect, NSect : WORD; VAR Buffer) : WORD;π { Read absolute disk sectors }ππ VARπ kbuff : ARRAY [0..$1f] OF BYTE; {Read Ralf Brown's interrupt listing}π kPtr : POINTER; {Int 25h - ES:[BP+1E] may change }π bufPtr : POINTER;ππ BEGINππ kPtr := @kbuff;π BufPtr := @buffer;ππ Asmπ push esπ push bpπ push diπ les di, kPtr { move past first 31 bytes }π mov al, drive { Gets the passed parameter. }π AND al, 1fh { Cvt from ASCII to drive num }π DEC al { Adjust because A: is drive 0 }π mov cx, nsect { number of sectors to read }π mov dx, ssect { starting at sector.. }π push dsπ lds bx, bufptr { Get the address of the buffer }π mov bp, diπ push siπ INT 25h { Do the drive read. }π pop si { Remove the flags int 25h leaves on stack}π pop siπ pop dsπ pop diπ pop bpπ pop esπ jc @1π mov @result, 0 { No errors, so set Function to zero }π jmp @Escapeπ @1 :π mov @result, axππ @Escape :π END;π END;ππProcedure bootlook(Drive : Char);πVarπ ReadResult : WORD;π I : Integer;πbeginπ { Get diskette info }π ReadResult := DiskRead(Drive,0,1,boot);π if ReadResult <> 0 thenπ beginπ { Error code here , there are LOTS of them.. see a good DOS bookπ most common will be :π 2 = Drive NOT readyπ 7 = unknown media .. not a boot diskπ 8 = sector not found .. not a boot disk }π Writeln(LO(ReadResult));π endπ elseπ beginπ WITH Boot DOπ BEGINπ { I'll just print a few of the possible items }π Write('OEM : ');π FOR I := 0 TO 7 DO WRITE(CHR(OEM[i]));π Writeln;π WriteLn('Dir Entrys : ',DirEntrys : 4);π WriteLn('Fat Tables : ',FatTables : 4);π WriteLn('Num Heads : ',NumHeads : 4);π WriteLn('Secs p/Trk : ',SecsTrak : 4);π WriteLn('Hidden Secs : ',HidnSecs : 4);π END;π end;ππend; { Procedure bootlook }ππBEGINπClrScr;πBootLook('B'); { if drive isn't bootable, you'll get an error (7) }πReadkey; { try it, this is a safe procedure }πEND.π 49 11-21-9309:25ALL HENNING JORGENSEN FORMAT FLOPPY SWAG9311 244 ╣ {$R-,S-,I-,B-,F-,O+}ππ{---------------------------------------------------------π BIOS disk I/O routines for floppy drives. Supports DOSπ real mode, DOS protected mode, and Windows. Requiresπ TP6, TPW, or BP7.ππ All functions are for floppy disks only; no hard drives.ππ See the individual types and functions in the interface ofπ this unit for more information. See the FMT.PAS sampleπ program for an example of formatting disks.ππ For status code definitions, see the implementation ofπ function GetStatusStr.ππ ---------------------------------------------------------π Based on a unit provided by Henning Jorgensen of Denmark.π Modified and cleaned up by TurboPower Software for pmodeπ and Windows operation.ππ TurboPower Softwareπ P.O. Box 49009π Colorado Springs, CO 80949-9009ππ CompuServe: 76004,2611ππ Version 1.0 10/25/93π Version 1.1 10/29/93π fix a dumb bug in the MediaArray checkπ ---------------------------------------------------------}ππunit BDisk;π {-BIOS disk I/O routines for floppy drives}ππinterfaceππconstπ MaxRetries : Byte = 3; {Number of automatic retries forπ read, write, verify, format}ππtypeπ DriveNumber = 0..7; {Acceptable floppy drive numbers}π {Generally, 0 = A, 1 = B}ππ DriveType = 0..4; {Floppy drive or disk types}π {0 = unknown or errorπ 1 = 360Kπ 2 = 1.2Mπ 3 = 720Kπ 4 = 1.44M}ππ VolumeStr = String[11]; {String for volume labels}ππ FormatAbortFunc = {Prototype for format abort func}π function (Track : Byte; {Track number being formatted, 0..MaxTrack}π MaxTrack : Byte; {Maximum track number for this format}π Kind : Byte {0 = format beginning}π {1 = formatting Track}π {2 = verifying Track}π {3 = writing boot and FAT}π {4 = format ending, Track = format status}π ) : Boolean; {Return True to abort format}πππprocedure ResetDrive(Drive : DriveNumber);π {-Reset drive system (function $00). Call after any otherπ disk function fails}πππfunction GetDiskStatus : Byte;π {-Get status of last int $13 operation (function $01)}πππfunction GetStatusStr(ErrNum : Byte) : String;π {-Return message string for any of the status codes used byπ this unit.}πππfunction GetDriveType(Drive : DriveNumber) : DriveType;π {-Get drive type (function $08). Note that this returns theπ type of the *drive*, not the type of the diskette in it.π GetDriveType returns 0 for an invalid drive.}πππfunction AllocBuffer(var P : Pointer; Size : Word) : Boolean;π {-Allocate a buffer useable in real and protected mode.π Buffers passed to ReadSectors and WriteSectors in pmodeπ *MUST* be allocated by using this function. AllocBuffer returnsπ False if sufficient memory is not available. P is also set toπ nil in that case.}πππprocedure FreeBuffer(P : Pointer; Size : Word);π {-Free buffer allocated by AllocBuffer. Size must match theπ size originally passed to AllocBuffer. FreeBuffer doesπ nothing if P is nil.}πππfunction ReadSectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π {-Read absolute disk sectors (function $02). Track, Side,π and SSect specify the location of the first sector toπ read. NSect is the number of sectors to read. Bufferπ must be large enough to hold these sectors. ReadSectorsπ returns a status code, 0 for success.}πππfunction WriteSectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π {-Write absolute disk sectors (function $03). Track, Side,π and SSect specify the location of the first sector toπ write. NSect is the number of sectors to write. Bufferπ must contain all the data to write. WriteSectorsπ returns a status code, 0 for success.}πππfunction VerifySectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte) : Byte;π {-Verify absolute disk sectors (function $04). Thisπ tests a computed CRC with the CRC stored along with theπ sector. Track, Side, and SSect specify the location ofπ the first sector to verify. NSect is the number ofπ sectors to verify. VerifySectors returns a status code,π 0 for success. Don't call VerifySectors on PC/XTs andπ PC/ATs with a BIOS from 1985. It will overwrite theπ stack.}πππfunction FormatDisk(Drive : DriveNumber; DType : DriveType;π Verify : Boolean; MaxBadSects : Byte;π VLabel : VolumeStr;π FAF : FormatAbortFunc) : Byte;π {-Format drive that contains a disk of type DType. If Verifyπ is True, each track is verified after it is formatted.π MaxBadSects specifies the number of sectors that can beπ bad before the format is halted. If VLabel is not anπ empty string, FormatDisk puts the BIOS-level volumeπ label onto the diskette. It does *not* add a DOS-levelπ volume label. FAF is a user function hook that can beπ used to display status during the format, and to abortπ the format if the user so chooses. Parameters passed toπ this function are described in FormatAbortFunc above.π FormatDisk also writes a boot sector and empty Fileπ Allocation Tables for the disk. FormatDisk returns aπ status code, 0 for success.}πππfunction EmptyAbortFunc(Track : Byte; MaxTrack : Byte; Kind : Byte) : Boolean;π {-Do-nothing abort function for FormatDisk}ππ {========================================================================}ππimplementationππusesπ{$IFDEF DPMI}π WinApi,π Dos;π {$DEFINE pmode}π{$ELSE}π{$IFDEF Windows}π WinApi,π WinDos;π {$DEFINE pmode}π{$ELSE}π Dos;π {$UNDEF pmode}π{$ENDIF}π{$ENDIF}ππ{$IFDEF Windows}πtypeπ Registers = TRegisters;π DateTime = TDateTime;π{$ENDIF}ππtypeπ DiskRec =π recordπ SSZ : Byte; {Sector size}π SPT : Byte; {Sectors/track}π TPD : Byte; {Tracks/disk}π SPF : Byte; {Sectors/FAT}π DSC : Byte; {Directory sectors}π FID : Byte; {Format id for FAT}π BRD : array[0..13] of Byte; {Variable boot record data}π end;π DiskRecs = array[1..4] of DiskRec;π SectorArray = array[0..511] of Byte;ππconstπ DData : DiskRecs = {BRD starts at offset 13 of FAT}π ((SSZ : $02; SPT : $09; TPD : $27; SPF : $02; DSC : $07; FID : $FD; {5.25" - 360K}π BRD : ($02, $01, $00, $02, $70, $00, $D0, $02, $FD, $02, $00, $09, $00, $02)),π (SSZ : $02; SPT : $0F; TPD : $4F; SPF : $07; DSC : $0E; FID : $F9; {5.25" - 1.2M}π BRD : ($01, $01, $00, $02, $E0, $00, $60, $09, $F9, $07, $00, $0F, $00, $02)),π (SSZ : $02; SPT : $09; TPD : $4F; SPF : $03; DSC : $07; FID : $F9; {3.50" - 720K}π BRD : ($02, $01, $00, $02, $70, $00, $A0, $05, $F9, $03, $00, $09, $00, $02)),π (SSZ : $02; SPT : $12; TPD : $4F; SPF : $09; DSC : $0E; FID : $F0; {3.50" - 1.44M}π BRD : ($01, $01, $00, $02, $E0, $00, $40, $0B, $F0, $09, $00, $12, $00, $02)));ππ BootRecord : SectorArray = {Standard boot program}π ($EB, $34, $90, $41, $4D, $53, $54, $20, $33, $2E, $30, $00, $02, $01, $01, $00, $02, $E0, $00, $40, $0B, $F0, $09, $00,π $12, $00, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $12,π $00, $00, $00, $00, $01, $00, $FA, $33, $C0, $8E, $D0, $BC, $00, $7C, $16, $07, $BB, $78, $00, $36, $C5, $37, $1E, $56,π $16, $53, $BF, $2B, $7C, $B9, $0B, $00, $FC, $AC, $26, $80, $3D, $00, $74, $03, $26, $8A, $05, $AA, $8A, $C4, $E2, $F1,π $06, $1F, $89, $47, $02, $C7, $07, $2B, $7C, $FB, $CD, $13, $72, $67, $A0, $10, $7C, $98, $F7, $26, $16, $7C, $03, $06,π $1C, $7C, $03, $06, $0E, $7C, $A3, $3F, $7C, $A3, $37, $7C, $B8, $20, $00, $F7, $26, $11, $7C, $8B, $1E, $0B, $7C, $03,π $C3, $48, $F7, $F3, $01, $06, $37, $7C, $BB, $00, $05, $A1, $3F, $7C, $E8, $9F, $00, $B8, $01, $02, $E8, $B3, $00, $72,π $19, $8B, $FB, $B9, $0B, $00, $BE, $D6, $7D, $F3, $A6, $75, $0D, $8D, $7F, $20, $BE, $E1, $7D, $B9, $0B, $00, $F3, $A6,π $74, $18, $BE, $77, $7D, $E8, $6A, $00, $32, $E4, $CD, $16, $5E, $1F, $8F, $04, $8F, $44, $02, $CD, $19, $BE, $C0, $7D,π $EB, $EB, $A1, $1C, $05, $33, $D2, $F7, $36, $0B, $7C, $FE, $C0, $A2, $3C, $7C, $A1, $37, $7C, $A3, $3D, $7C, $BB, $00,π $07, $A1, $37, $7C, $E8, $49, $00, $A1, $18, $7C, $2A, $06, $3B, $7C, $40, $38, $06, $3C, $7C, $73, $03, $A0, $3C, $7C,π $50, $E8, $4E, $00, $58, $72, $C6, $28, $06, $3C, $7C, $74, $0C, $01, $06, $37, $7C, $F7, $26, $0B, $7C, $03, $D8, $EB,π $D0, $8A, $2E, $15, $7C, $8A, $16, $FD, $7D, $8B, $1E, $3D, $7C, $EA, $00, $00, $70, $00, $AC, $0A, $C0, $74, $22, $B4,π $0E, $BB, $07, $00, $CD, $10, $EB, $F2, $33, $D2, $F7, $36, $18, $7C, $FE, $C2, $88, $16, $3B, $7C, $33, $D2, $F7, $36,π $1A, $7C, $88, $16, $2A, $7C, $A3, $39, $7C, $C3, $B4, $02, $8B, $16, $39, $7C, $B1, $06, $D2, $E6, $0A, $36, $3B, $7C,π $8B, $CA, $86, $E9, $8A, $16, $FD, $7D, $8A, $36, $2A, $7C, $CD, $13, $C3, $0D, $0A, $4E, $6F, $6E, $2D, $53, $79, $73,π $74, $65, $6D, $20, $64, $69, $73, $6B, $20, $6F, $72, $20, $64, $69, $73, $6B, $20, $65, $72, $72, $6F, $72, $0D, $0A,π $52, $65, $70, $6C, $61, $63, $65, $20, $61, $6E, $64, $20, $73, $74, $72, $69, $6B, $65, $20, $61, $6E, $79, $20, $6B,π $65, $79, $20, $77, $68, $65, $6E, $20, $72, $65, $61, $64, $79, $0D, $0A, $00, $0D, $0A, $44, $69, $73, $6B, $20, $42,π $6F, $6F, $74, $20, $66, $61, $69, $6C, $75, $72, $65, $0D, $0A, $00, $49, $4F, $20, $20, $20, $20, $20, $20, $53, $59,π $53, $4D, $53, $44, $4F, $53, $20, $20, $20, $53, $59, $53, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,π $00, $00, $00, $00, $00, $00, $55, $AA);ππ MediaArray : array[DriveType, 1..2] of Byte =π (($00, $00), {Unknown disk}π ($01, $02), {360K disk}π ($00, $03), {1.2M disk}π ($00, $04), {720K disk}π ($00, $04)); {1.44M disk}ππ{$IFDEF pmode}πtypeπ DPMIRegisters =π recordπ DI : LongInt;π SI : LongInt;π BP : LongInt;π Reserved : LongInt;π BX : LongInt;π DX : LongInt;π CX : LongInt;π AX : LongInt;π Flags : Word;π ES : Word;π DS : Word;π FS : Word;π GS : Word;π IP : Word;π CS : Word;π SP : Word;π SS : Word;π end;ππ function GetRealSelector(RealPtr : Pointer; Limit : Word) : Word;π {-Set up a selector to point to RealPtr memory}π typeπ OS =π recordπ O, S : Word;π end;π varπ Status : Word;π Selector : Word;π Base : LongInt;π beginπ GetRealSelector := 0;π Selector := AllocSelector(0);π if Selector = 0 thenπ Exit;π {Assure a read/write selector}π Status := ChangeSelector(CSeg, Selector);π Base := (LongInt(OS(RealPtr).S) shl 4)+LongInt(OS(RealPtr).O);π if SetSelectorBase(Selector, Base) = 0 then beginπ Selector := FreeSelector(Selector);π Exit;π end;π Status := SetSelectorLimit(Selector, Limit);π GetRealSelector := Selector;π end;ππ procedure GetRealIntVec(IntNo : Byte; var Vector : Pointer); Assembler;π asmπ mov ax,0200hπ mov bl,IntNoπ int 31hπ les di,Vectorπ mov word ptr es:[di],dxπ mov word ptr es:[di+2],cxπ end;ππ function RealIntr(IntNo : Byte; var Regs : DPMIRegisters) : Word; Assembler;π asmπ xor bx,bxπ mov bl,IntNoπ xor cx,cx {StackWords = 0}π les di,Regsπ mov ax,0300hπ int 31hπ jc @@ExitPointπ xor ax,axπ @@ExitPoint:π end;π{$ENDIF}ππ procedure Int13Call(var Regs : Registers);π {-Call int $13 for real or protected mode}π{$IFDEF pmode}π varπ Base : LongInt;π DRegs : DPMIRegisters;π{$ENDIF}π beginπ{$IFDEF pmode}π {This pmode code is valid only for the AH values used in this unit}π FillChar(DRegs, SizeOf(DPMIRegisters), 0);π DRegs.AX := Regs.AX;π DRegs.BX := Regs.BX;π DRegs.CX := Regs.CX;π DRegs.DX := Regs.DX;π case Regs.AH ofπ 2, 3, 5 :π {Calls that use ES as a buffer segment}π beginπ Base := GetSelectorBase(Regs.ES);π if (Base <= 0) or (Base > $FFFF0) then beginπ Regs.Flags := 1;π Regs.AX := 1;π Exit;π end;π DRegs.ES := Base shr 4;π end;π end;π if RealIntr($13, DRegs) <> 0 then beginπ Regs.Flags := 1;π Regs.AX := 1;π end else beginπ Regs.Flags := DRegs.Flags;π Regs.AX := DRegs.AX;π Regs.BX := DRegs.BX; {BX is returned by GetDriveType function only}π end;ππ{$ELSE}π Intr($13, Regs);π{$ENDIF}π end;ππ function GetDriveType(Drive : DriveNumber) : DriveType;π varπ Regs : Registers;π beginπ Regs.AH := $08;π Regs.DL := Drive;π Int13Call(Regs);π if Regs.AH = 0 thenπ GetDriveType := Regs.BLπ elseπ GetDriveType := 0;π end;ππ function GetDiskStatus : Byte;π varπ Regs : Registers;π beginπ Regs.AH := $01;π Int13Call(Regs);π GetDiskStatus := Regs.AL;π end;ππ function GetStatusStr(ErrNum : Byte) : String;π varπ NumStr : string[3];π beginπ case ErrNum ofπ {Following codes are defined by the floppy BIOS}π $00 : GetStatusStr := '';π $01 : GetStatusStr := 'Invalid command';π $02 : GetStatusStr := 'Address mark not found';π $03 : GetStatusStr := 'Disk write protected';π $04 : GetStatusStr := 'Sector not found';π $06 : GetStatusStr := 'Floppy disk removed';π $08 : GetStatusStr := 'DMA overrun';π $09 : GetStatusStr := 'DMA crossed 64KB boundary';π $0C : GetStatusStr := 'Media type not found';π $10 : GetStatusStr := 'Uncorrectable CRC error';π $20 : GetStatusStr := 'Controller failed';π $40 : GetStatusStr := 'Seek failed';π $80 : GetStatusStr := 'Disk timed out';ππ {Following codes are added by this unit}π $FA : GetStatusStr := 'Format aborted';π $FB : GetStatusStr := 'Invalid media type';π $FC : GetStatusStr := 'Too many bad sectors';π $FD : GetStatusStr := 'Disk bad';π $FE : GetStatusStr := 'Invalid drive or type';π $FF : GetStatusStr := 'Insufficient memory';π elseπ Str(ErrNum, NumStr);π GetStatusStr := 'Unknown error '+NumStr;π end;π end;ππ procedure ResetDrive(Drive : DriveNumber);π varπ Regs : Registers;π beginπ Regs.AH := $00;π Regs.DL := Drive;π Int13Call(Regs);π end;ππ function AllocBuffer(var P : Pointer; Size : Word) : Boolean;π varπ L : LongInt;π beginπ{$IFDEF pmode}π L := GlobalDosAlloc(Size);π if L <> 0 then beginπ P := Ptr(Word(L and $FFFF), 0);π AllocBuffer := True;π end else beginπ P := nil;π AllocBuffer := Falseπ end;π{$ELSE}π if MaxAvail >= Size then beginπ GetMem(P, Size);π AllocBuffer := True;π end else beginπ P := nil;π AllocBuffer := False;π end;π{$ENDIF}π end;ππ procedure FreeBuffer(P : Pointer; Size : Word);π beginπ if P = nil thenπ Exit;π{$IFDEF pmode}π Size := GlobalDosFree(LongInt(P) shr 16);π{$ELSE}π FreeMem(P, Size);π{$ENDIF}π end;ππ function CheckParms(DType : DriveType; Drive : DriveNumber) : Boolean;π {-Make sure drive and type are within range}π beginπ CheckParms := False;π if (DType < 1) or (DType > 4) thenπ Exit;π if (Drive > 7) thenπ Exit;π CheckParms := True;π end;ππ function SubfSectors(SubFunc : Byte;π Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π {-Code shared by ReadSectors, WriteSectors, VerifySectors, FormatTrack}π varπ Tries : Byte;π Done : Boolean;π Regs : Registers;π beginπ Tries := 1;π Done := False;π repeatπ Regs.AH := SubFunc;π Regs.AL := NSect;π Regs.CH := Track;π Regs.CL := SSect;π Regs.DH := Side;π Regs.DL := Drive;π Regs.ES := Seg(Buffer);π Regs.BX := Ofs(Buffer);π Int13Call(Regs);ππ if Regs.AH <> 0 then beginπ ResetDrive(Drive);π Inc(Tries);π if Tries > MaxRetries thenπ Done := True;π end elseπ Done := True;π until Done;ππ SubfSectors := Regs.AH;π end;ππ function ReadSectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π beginπ ReadSectors := SubfSectors($02, Drive, Track, Side, SSect, NSect, Buffer);π end;ππ function WriteSectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π beginπ WriteSectors := SubfSectors($03, Drive, Track, Side, SSect, NSect, Buffer);π end;ππ function VerifySectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte) : Byte;π varπ Dummy : Byte;π beginπ VerifySectors := SubfSectors($04, Drive, Track, Side, SSect, NSect, Dummy);π end;ππ function SetDriveTable(DType : DriveType) : Boolean;π {-Set drive table parameters for formatting}π varπ P : Pointer;π DBSeg : Word;π DBOfs : Word;π beginπ SetDriveTable := False;ππ{$IFDEF pmode}π GetRealIntVec($1E, P);π DBSeg := GetRealSelector(P, $FFFF);π if DBSeg = 0 thenπ Exit;π DBOfs := 0;π{$ELSE}π GetIntVec($1E, P);π DBSeg := LongInt(P) shr 16;π DBOfs := LongInt(P) and $FFFF;π{$ENDIF}ππ {Set gap length for formatting}π case DType ofπ 1 : Mem[DBSeg:DBOfs+7] := $50; {360K}π 2 : Mem[DBSeg:DBOfs+7] := $54; {1.2M}π 3,π 4 : Mem[DBSeg:DBOfs+7] := $6C; {720K or 1.44M}π end;ππ {Set max sectors/track}π Mem[DBSeg:DBOfs+4] := DData[DType].SPT;ππ{$IFDEF pmode}π DBSeg := FreeSelector(DBSeg);π{$ENDIF}ππ SetDriveTable := True;π end;ππ function GetMachineID : Byte;π {-Return machine ID code}π{$IFDEF pmode}π varπ SegFFFF : Word;π{$ENDIF}π beginπ{$IFDEF pmode}π SegFFFF := GetRealSelector(Ptr($FFFF, $0000), $FFFF);π if SegFFFF = 0 thenπ GetMachineID := 0π else beginπ GetMachineID := Mem[SegFFFF:$000E];π SegFFFF := FreeSelector(SegFFFF);π end;π{$ELSE}π GetMachineID := Mem[$FFFF:$000E];π{$ENDIF}π end;ππ function IsATMachine : Boolean;π {-Return True if AT or better machine}π beginπ IsATMachine := False;π if Lo(DosVersion) >= 3 thenπ case GetMachineId ofπ $FC, $F8 : {AT or PS/2}π IsATMachine := True;π end;π end;ππ function GetChangeLineType(Drive : DriveNumber; var CLT : Byte) : Byte;π {-Return change line type of drive}π varπ Regs : Registers;π beginπ Regs.AH := $15;π Regs.DL := Drive;π Int13Call(Regs);π if (Regs.Flags and FCarry) <> 0 then beginπ GetChangeLineType := Regs.AH;π CLT := 0;π end else beginπ GetChangeLineType := 0;π CLT := Regs.AH;π end;π end;ππ function SetFloppyType(Drive : DriveNumber; FType : Byte) : Byte;π {-Set floppy type for formatting}π varπ Tries : Byte;π Done : Boolean;π Regs : Registers;π beginπ Tries := 1;π Done := False;π repeatπ Regs.AH := $17;π Regs.AL := FType;π Regs.DL := Drive;π Int13Call(Regs);π if Regs.AH <> 0 then beginπ ResetDrive(Drive);π Inc(Tries);π if Tries > MaxRetries thenπ Done := True;π end elseπ Done := True;π until Done;ππ SetFloppyType := Regs.AH;π end;ππ function SetMediaType(Drive : DriveType; TPD : Byte; SPT : Byte) : Byte;π {-Set media type for formatting}π varπ Regs : Registers;π beginπ Regs.AH := $18;π Regs.DL := Drive;π Regs.CH := TPD;π Regs.CL := SPT;π Int13Call(Regs);π SetMediaType := Regs.AH;π end;ππ function FormatDisk(Drive : DriveNumber; DType : DriveType;π Verify : Boolean; MaxBadSects : Byte;π VLabel : VolumeStr;π FAF : FormatAbortFunc) : Byte;π labelπ ExitPoint;π typeπ CHRNRec =π recordπ CTrack : Byte; {Track 0..?}π CSide : Byte; {Side 0..1}π CSect : Byte; {Sector 1..?}π CSize : Byte; {Size 0..?}π end;π CHRNArray = array[1..18] of CHRNRec;π FATArray = array[0..4607] of Byte;π varπ Tries : Byte;π Track : Byte;π Side : Byte;π Sector : Byte;π RWritten : Byte;π RTotal : Byte;π FatNum : Byte;π BadSects : Byte;π ChangeLine : Byte;π DiskType : Byte;π Status : Byte;π Done : Boolean;π Trash : Word;π DT : DateTime;π VDate : LongInt;π Regs : Registers;π BootPtr : ^SectorArray;π CHRN : ^CHRNArray;π FATs : ^FATArray;ππ procedure MarkBadSector(Track, Side, Sector : Byte);π constπ BadMark = $FF7; {Bad cluster mark}π varπ CNum : Integer; {Cluster number}π FOfs : Word; {Offset into fat for this cluster}π FVal : Word; {FAT value for this cluster}π OFVal : Word; {Old FAT value for this cluster}π beginπ CNum := (((((Track*2)+Side)*DData[DType].SPT)+Sector-RTotal-2) divπ DData[DType].BRD[0])+2;π if CNum > 1 then beginπ {Sector is in data space}π FOfs := (CNum*3) div 2;π Move(FATs^[FOfs], FVal, 2);π if Odd(CNum) thenπ OFVal := (FVal and (BadMark shl 4))π elseπ OFVal := (FVal and BadMark);π if OFVal = 0 then beginπ {Not already marked bad, mark it}π if Odd(CNum) thenπ FVal := (FVal or (BadMark shl 4))π elseπ FVal := (FVal or BadMark);π Move(FVal, FATs^[FOfs], 2);π {Add to bad sector count}π Inc(BadSects, DData[DType].BRD[0]);π end;π end;π end;ππ beginπ {Validate parameters. Can't do anything unless these are reasonable}π if not CheckParms(DType, Drive) thenπ Exit;ππ {Initialize buffer pointers in case of failure}π FATs := nil;π CHRN := nil;π BootPtr := nil;ππ {Status proc: starting format}π if FAF(0, DData[DType].TPD, 0) then beginπ Status := $FA;π goto ExitPoint;π end;ππ {Error code for invalid drive or media type}π Status := $FE;ππ case GetDriveType(Drive) ofπ 1 : {360K drive formats only 360K disks}π if DType <> 1 thenπ goto ExitPoint;π 2 : {1.2M drive formats 360K or 1.2M disk}π if DType > 2 thenπ goto ExitPoint;π 3 : {720K drive formats only 720K disks}π if DType <> 3 thenπ goto ExitPoint;π 4 : {1.44M drive formats 720K or 1.44M disks}π if Dtype < 3 thenπ goto ExitPoint;π elseπ goto ExitPoint;π end;ππ {Error code for out-of-memory or DPMI error}π Status := $FF;ππ {Allocate buffers}π if not AllocBuffer(Pointer(FATs), SizeOf(FATArray)) thenπ goto ExitPoint;π if not AllocBuffer(Pointer(CHRN), SizeOf(CHRNArray)) thenπ goto ExitPoint;π if not AllocBuffer(Pointer(BootPtr), SizeOf(BootRecord)) thenπ goto ExitPoint;ππ {Initialize boot record}π Move(BootRecord, BootPtr^, SizeOf(BootRecord));π Move(DData[DType].BRD, BootPtr^[13], 14);ππ {Initialize the FAT table}π FillChar(FATs^, SizeOf(FATArray), 0);π FATs^[0] := DData[DType].FID;π FATs^[1] := $FF;π FATs^[2] := $FF;ππ {Set drive table parameters by patching drive table in memory}π if not SetDriveTable(DType) thenπ goto ExitPoint;ππ {On AT class machines, set format parameters via BIOS}π if IsATMachine then beginπ {Get change line type: 1 -> 360K drive, 2 -> 1.2M or 3.5" drive}π Status := GetChangeLineType(Drive, ChangeLine);π if Status <> 0 thenπ goto ExitPoint;π if (ChangeLine < 1) or (ChangeLine > 2) then beginπ Status := 1;π goto ExitPoint;π end;ππ {Determine floppy type for SetFloppyType call}π DiskType := MediaArray[DType, ChangeLine];π if DiskType = 0 then beginπ Status := $FB;π goto ExitPoint;π end;ππ {Set floppy type for drive}π Status := SetFloppyType(Drive, DiskType);π if Status <> 0 thenπ goto ExitPoint;ππ {Set media type for format}π Status := SetMediaType(Drive, DData[DType].TPD, DData[DType].SPT);π if Status <> 0 thenπ goto ExitPoint;π end;ππ {Format each sector}π ResetDrive(Drive);π BadSects := 0;ππ for Track := 0 to DData[DType].TPD do beginπ {Status proc: formatting track}π if FAF(Track, DData[DType].TPD, 1) then beginπ Status := $FA;π goto ExitPoint;π end;ππ for Side := 0 to 1 do beginπ {Initialize CHRN for this sector}π for Sector := 1 to DData[DType].SPT doπ with CHRN^[Sector] do beginπ CTrack := Track;π CSide := Side;π CSect := Sector;π CSize := DData[DType].SSZ;π end;ππ {Format this sector, with retries}π Status := SubfSectors($05, Drive, Track, Side,π 1, DData[DType].SPT, CHRN^);π if Status <> 0 thenπ goto ExitPoint;π end;ππ if Verify then beginπ {Status proc: verifying track}π if FAF(Track, DData[DType].TPD, 2) then beginπ Status := $FA;π goto ExitPoint;π end;ππ for Side := 0 to 1 doπ {Verify the entire track}π if VerifySectors(Drive, Track, Side,π 1, DData[DType].SPT) <> 0 then beginπ if Track = 0 then beginπ {Disk bad}π Status := $FD;π goto ExitPoint;π end;ππ for Sector := 1 to DData[DType].SPT doπ if VerifySectors(Drive, Track, Side,π Sector, 1) <> 0 then beginπ MarkBadSector(Track, Side, Sector);π if BadSects > MaxBadSects then beginπ Status := $FC;π goto ExitPoint;π end;π end;π end;π end;π end;ππ {Status proc: writing boot and FAT}π if FAF(0, DData[DType].TPD, 3) then beginπ Status := $FA;π goto ExitPoint;π end;ππ {Write boot record}π Status := WriteSectors(Drive, 0, 0, 1, 1, BootPtr^);π if Status <> 0 then beginπ Status := $FD;π goto ExitPoint;π end;ππ {Write FATs and volume label}π Track := 0;π Side := 0;π Sector := 2;π FatNum := 0;π RTotal := (2*DData[DType].SPF)+DData[DType].DSC;π for RWritten := 0 to RTotal-1 do beginπ if Sector > DData[DType].SPT then beginπ Sector := 1;π Inc(Side);π end;ππ if RWritten < (2*DData[DType].SPF) then beginπ if FatNum > DData[DType].SPF-1 thenπ FatNum := 0;π end else beginπ FillChar(FATs^, 512, 0);π if ((VLabel <> '') and (RWritten = 2*DData[DType].SPF)) then beginπ {Put in volume label}π for Trash := 1 to Length(VLabel) doπ VLabel[Trash] := Upcase(VLabel[Trash]);π while Length(VLabel) < 11 doπ VLabel := VLabel+' ';π Move(VLabel[1], FATs^, 11);π FATs^[11] := 8;π GetDate(DT.Year, DT.Month, DT.Day, Trash);π GetTime(DT.Hour, DT.Min, DT.Sec, Trash);π PackTime(DT, VDate);π Move(VDate, FATs^[22], 4);π end;π FatNum := 0;π end;ππ if WriteSectors(Drive, Track, Side,π Sector, 1, FATs^[FatNum*512]) <> 0 then beginπ Status := $FD;π goto ExitPoint;π end;ππ Inc(Sector);π Inc(FatNum);π end;ππ {Success}π Status := 0;ππExitPoint:π FreeBuffer(BootPtr, SizeOf(BootRecord));π FreeBuffer(CHRN, SizeOf(CHRNArray));π FreeBuffer(FATs, SizeOf(FATArray));ππ {Status proc: ending format}π Done := FAF(Status, DData[DType].TPD, 4);π FormatDisk := Status;π end;ππ function EmptyAbortFunc(Track, MaxTrack : Byte; Kind : Byte) : Boolean;π beginπ EmptyAbortFunc := False;π end;ππend.ππ{ ------------------------------- DEMO PROGRAM -------------------- }π{ ------------------------------- CUT HERE ---------------------}ππ{$R-,S-,I-}ππprogram Fmt;π {-Simple formatting program to demonstate DISKB unit}ππusesπ{$IFDEF Windows}π WinCrt,π{$ENDIF}π BDisk;ππconstπ ESC = #27;π CR = #13;ππtypeπ CharSet = set of Char;ππvarπ DLet : Char;π DTyp : Char;π Verf : Char;π GLet : Char;π DNum : Byte;π Status : Byte;π VStr : VolumeStr;ππconstπ DriveTypeName : array[DriveType] of string[5] =π ('other', '360K', '1.2M', '720K', '1.44M');ππ{$IFNDEF Windows}π function ReadKey : Char; assembler;π {-Low budget readkey routine}π asmπ xor ah,ahπ int 16hπ end;π{$ENDIF}ππ function GetKey(Prompt : String; OKSet : CharSet) : Char;π {-Get and return a key in the OKSet}π varπ Ch : Char;π beginπ Write(Prompt);π repeatπ Ch := Upcase(ReadKey);π if Ch = ESC then beginπ WriteLn;π Halt;π end;π until (Ch in OKSet);π if Ch <> CR thenπ Write(Ch);π WriteLn;π GetKey := Ch;π end;ππ function AbortFunc(Track, MaxTrack : Byte; Kind : Byte) : Boolean; far;π {-Display formatting status. Could check for abort here too}π beginπ case Kind ofπ 0 : {Format beginning}π Write('Formatting ');π 1 : {Formatting track}π Write(^H^H^H^H, ((Track*100) div MaxTrack):3, '%');π 2 : {Verifying track}π Write(^H, 'V');π 3 : {Writing boot and FAT}π Write(^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H, 'Writing boot and FAT');π 4 : {Format ending}π beginπ Write(^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H);π {Track returns final status code in this case}π if Track = 0 thenπ WriteLn('Formatted successfully')π elseπ WriteLn('Format failed: ', GetStatusStr(Track));π end;π end;π AbortFunc := False;π end;ππbeginπ WriteLn('Floppy Formatter: <Esc> to exit');ππ {Get formatting parameters}π DLet := GetKey('Drive to format? (A or B): ', ['A'..'B']);π DTyp := GetKey('Disk type? (1=360K, 2=1.2M, 3=720K, 4=1.44M): ', ['1'..'4']);π Verf := GetKey('Verify? (Y or N) ', ['N', 'Y']);π Write('Volume label? ');π ReadLn(VStr);π GLet := GetKey('Insert disk and press <Enter> ', [#13]);ππ {Compute drive number}π DNum := Byte(DLet)-Byte('A');ππ WriteLn('Drive type is ', DriveTypeName[GetDriveType(DNum)]);ππ Status := FormatDisk(DNum, {drive number}π Byte(DTyp)-Byte('0'), {format type}π (Verf = 'Y'), {verify?}π 10, {max bad sectors}π VStr, {volume label}π AbortFunc); {abort function}π {AbortFunc reports the status}πend.π 50 11-02-9306:17ALL JIMISOLA LAURSEN Disk Serial Number in ASMSWAG9311 14 ╣ {πjimisola.laursen@cindy.ct.se (jimisola laursen)ππ> Anybody know how to read the Volume Serial Number from a (hard) disk??π> No problem getting the Volume Label, but this seemsa to be another matter...π}ππUnit Serial;ππInterfaceππUsesπ Dos;ππFunction Get_Serial_number(Drive : Byte) : String;ππImplementationππAsmπ mov ax, wπ mov bx, bπ xor cx, cxπ les di, @resultπ xor si, siπ jcxz @@@20π @@@10:π xor dx, dxπ div bxπ cmp dl, 10π jb @h10π add dl, 'A'-10π jmp @h20π @h10:π or dl, '0'π @h20:π push dxπ inc siπ loop @@@10π @@@20:π inc cxπ or ax, axπ jnz @@@10π mov cx, siπ jcxz @@@40π cldπ mov al, clπ stosbπ @@@30:π pop axπ stosbπ loop @@@30π @@@40:πend;ππFunction Get_Serial_number(Drive : Byte) : String;π(* "Drive" is 0=current, 1=A:, 2=B: osv.. *)πTypeπ Disk_info = Recordπ RES : Word; (* reserverad ska Vara 0 *)π SER_NR1 : Word; (* Serinummer (bin{rt) *)π SER_NR2 : Word; (* Serinummer (bin{rt) *)π VOL : Array [1..11] of Char;(* Volume Label *)π TYP : Array [1..8] of Char; (* tex 'FAT12' eller 'FAT16' *)π end;πVarπ D_I : Disk_Info;π s1, s2 : String[5];πbeginπ Asmπ push dsπ mov ax,ssπ mov ds,axπ lea dx,D_Iπ mov bl,driveπ mov ax,6900hπ int 21hπ pop dsπ end;π s1 := NumAscii(D_I.SER_NR2, 16);π s2 := NumAscii(D_I.SER_NR1, 16);π While length(s1) < 4 doπ s1 := '0' + s1;π While length(s2) < 4 doπ s2 := '0' + s2;π Get_Serial_number := s1 + '-' + s2;πend;ππend.π 51 10-28-9311:37ALL JON JASIUNAS DISK SERIAL SWAG9311 12 ╣ {===========================================================================πDate: 08-22-93 (01:50) Number: 35568πFrom: JON JASIUNAS Refer#: NONEπSubj: SERIAL # OF DISK Conf: (1221) F-PASCALπ--------------------------------------------------------------------------- }ππ Uses DOS, CRT;π Type MIDRecord = Recordπ InfoLevel : Word;π SerialNum : LongInt; {This is the serial number...}π VolLabel : Array[1..11] of Char;π FatType : Array[1..8] of Char;π End;πFunction Label_Fat(Var Mid : MidRecord; Drive : Word) : Boolean;πVar Result : Word;πVar Regs : Registers;πBeginπ FillChar(Mid,SizeOf(Mid),0);π FillChar(Regs,SizeOf(Regs),0);π With Regs DOπ Beginπ AX := $440D;π BX := Drive;π CX := $0866;π DS := Seg(Mid);π DX := Ofs(Mid);π Intr($21,Regs);π Case AX ofπ $01 : Label_Fat := False;π $02 : Label_Fat := False;π $05 : Label_Fat := False;π Else Label_Fat := True;π End;π End;πEnd;ππVar Mid : MidRecord;πBeginπ ClrScr;π If Label_Fat(Mid,0) Thenπ With Mid DOπ Beginπ Writeln(SerialNum);π Writeln(VolLabel);π Writeln(FatType);π Endπ Else Writeln('Error Occured');πEnd.ππ 52 11-02-9304:52ALL KENT BRIGGS Available Drives SWAG9311 10 ╣ {πKENT BRIGGSππ> Does anyone know how to check if a drive is valid Without accessingπ> it to see? For example, if the available drives on a system are: A, B,π> C, E. How do you check if drive A is installed Without having theπ> floppy drive lights go on. I use TP6, so if you include a sample code,π> could you make it compatible With it.π}ππProgram Show_drives;ππUsesπ Dos;ππVarπ Drv : Array [1..3] of Byte;ππProcedure ReportDrives;πVarπ Regs : Registers;π Count : Integer;π DrvList : String[26];π Fcb : Array [1..37] of Byte;πbeginπ DrvList := '';π For Count := 1 to 26 do {Try drives A..Z}π beginπ Drv[1] := Count + 64; {A=ASCII 65, etc}π Drv[2] := Ord(':');π Drv[3] := 0;π Regs.AX := $2906; {Dos Function 29h = Parse Filename}π Regs.SI := Ofs(Drv[1]); {Point to drive String}π Regs.DI := Ofs(Fcb[1]); {Point to File Control Block}π Regs.DS := DSeg;π Regs.ES := DSeg;π MsDos(Regs); {Dos Interrupt}π if Regs.AL <> $FF thenπ DrvList := DrvList + Chr(Count + 64);π end;π Writeln('Available drives = ', DrvList);πend;ππbeginπ ReportDrives;πend.ππ 53 09-26-9310:11ALL KENT BRIGGS Available Drives SWAG9311 14 ╣ (*π===========================================================================π BBS: Canada Remote SystemsπDate: 08-29-93 (15:41) Number: 36579πFrom: KENT BRIGGS Refer#: NONEπ To: HOWARD HUANG Recvd: NOπSubj: CHECK AVAILABLE DRIVES Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Howard Huang to All <=-ππ HH> Does anyone know how to check if a drive is valid without accessingπ HH> it to see? For example, if the available drives on a system are: A, B,π HH> C, E. How do you check if drive A is installed without having theπ HH> floppy drive lights go on. I use TP6, so if you include a sample code,π HH> could you make it compatible with it.ππ Howard, here's what I use:π*)πprogram show_drives;πuses dos;πvarπ reg: registers;π drv: array[1..3] of byte;π drvlist: string[26];π fcb: array[1..37] of byte;π i: integer;πbeginπ drvlist:='';π for i:=1 to 26 do {Try drives A..Z}π beginπ drv[1]:=i+64; {A=ASCII 65, etc}π drv[2]:=ord(':');π drv[3]:=0;π reg.ax:=$2906; {DOS function 29h = Parse Filename}π reg.si:=ofs(drv[1]); {Point to drive string}π reg.di:=ofs(fcb[1]); {Point to File Control Block}π reg.ds:=dseg;π reg.es:=dseg;π msdos(reg); {DOS Interrupt}π if reg.al<>$ff then drvlist:=drvlist+chr(i+64);π end;π writeln('Available drives = ',drvlist);πend.ππ___ Blue Wave/QWK v2.12π--- Renegade v07-17 Betaπ * Origin: Snipe's Castle BBS, Waco TX (817)-757-0169 (1:388/26)π 54 09-26-9308:47ALL MARTIN RICHARDSON Bytes per sector on disk SWAG9311 7 ╣ {*****************************************************************************π * Function ...... BytesPerSector()π * Purpose ....... To return the number of bytes per sector of a diskπ * Parameters .... nDrive Drive containing diskπ * Returns ....... The number of bytes per sector of the specified diskπ * Notes ......... Noneπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π *****************************************************************************}πFUNCTION BytesPerSector( nDrive: BYTE ): INTEGER;πVAR π Regs: Registers;πBEGINπ Regs.AH := $1C;π Regs.DL := nDrive;π MSDOS( Regs );π BytesPerSector := Regs.AL * Regs.CX;πEND;ππ 55 09-26-9309:27ALL MARTIN RICHARDSON Set the current Drive SWAG9311 11 ╣ {****************************************************************************π * Procedure ..... SetDrive()π * Purpose ....... To set the current driveπ * Parameters .... i Drive number to change to (0=A, 1=B, 2=C, etc.)π * Returns ....... N/Aπ * Notes ......... Noneπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π ****************************************************************************}πPROCEDURE SetDrive( i : INTEGER ); ASSEMBLER;πASMπ MOV AH, 0Ehπ MOV DL, BYTE PTR iπ INT 21hπEND;ππ{****************************************************************************π * Procedure ..... SetCDrive()π * Purpose ....... To set the current driveπ * Parameters .... c Drive letter to change toπ * Returns ....... N/Aπ * Notes ......... Same as SetDrive, but you pass the drive letter instead ofπ * number.π * . Uses function SetDriveπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π ****************************************************************************}πPROCEDURE SetCDrive( c :CHAR );πBEGINπ IF ( c IN ['A'..'Z'] ) THENπ SetDrive( POS( c, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' ) - 1 );πEND;ππ 56 11-02-9305:01ALL MAYNARD PHILBROOK Editing the BOOT Sector SWAG9311 9 ╣ {πMAYNARD PHILBROOKππ> How can I look With a pascal-Program(I have TP7.0)in the boot-sectorπ> of a disk and change them?π}ππUsesπ Dos;ππVarπ Sector : Array [1..512] of Byte;π Regs : Registers;ππFunction Read_Boot_Sector(Var Drive : Byte) : Boolean;πbeginπ With Regs doπ beginπ AH := $02; { Function Number Read_Sector }π AL := 1; { Number of Sectors to Read }π CH := 1; { Cylender Number, Upper 2 Bits used For HD }π CL := 0; { Bios use Zero base Numbers here }π DH := 0; { Head Number or Side 0 = side 1 }π DL := Drive; { 0 = A:, 1 := B: Floppys, Add $80 For Fisk Disk }π ES := Seg(Sector); { Pass the Address of Buffer }π BX := Ofs(Sector);π Intr($13, Regs); { Call Bios Int ); }π if Flags and $01 <> 0 Thenπ Read_Boot_Sector := Falseπ elseπ Read_Boot_Sector := True;π end;πend;ππbeginπ if Read_Boot_Sector(0) Thenπ WriteLn(' Got it ')π elseπ WriteLn(' Disk Error in reading ');πend.π 57 11-26-9317:01ALL PHIL NICKELL Disk Ready Function SWAG9311 10 ╣ {πFrom: PHIL NICKELLπSubj: Disk Ready Functionππ Here are a couple of ways that are about equivalent. Which you useπ depends on the info you might want about the drive. These callsπ actually spin up the disk and get info from the boot sector or the fatπ table, so they also incidentally check if the disk is ready and ok.π Unfortunately, DOS doesn't really have a reasonable way to tell you ifπ the disk is ready without it actually spinning up the drive.π}π var r:registers;ππ Get Allocation Table Infoπ ...on entryπ r.ah := $1ch;π r.dl := drivenum; { 0=default, 1=A, 2=B etc}π msdos(r);π ...on returnπ r.al = sectors per clusterπ r.cx = bytes per physical sectorπ r.dx = clusters per diskπ ds:bx = pointer to media descriptor byteππ Get Free Disk Space Infoπ ...on entryπ r.ah := $36;π r.dl := drivenum; { 0=default, 1=A, 2=B etc}π msdos(r);π ...on returnπ r.ax = sectors per cluster /or/π = $ffff if error.π r.bx = number of available clustersπ r.cx = bytes per sectorπ dx = clusters on the driveππ 58 11-21-9309:50ALL SWAG SUPPORT TEAM VOL Label Functions SWAG9311 24 ╣ UNIT VolFuncs;π(**) INTERFACE (**)πUSES Dos;πTYPEπ VolString = String[12];ππ FUNCTION GetLabel(driveNum : Byte;π VAR V : VolString) : Boolean;π FUNCTION SetLabel(driveNum : Byte;π NuLabel : VolString) : Boolean;π FUNCTION DelLabel(driveNum : Byte) : Boolean;ππ(**) IMPLEMENTATION (**)πTYPEπ ExFCB = RECORDπ FF : Byte; {must be 0FFh}π Reserved0 : ARRAY[1..5] OF Byte; {must be 0s}π Attribute : Byte;π DriveID : Byte;π Filename : ARRAY[1..8] OF Char;π Extension : ARRAY[1..3] OF Char;π CurBlock : Word;π RecSize : Word;π FileSize : LongInt;π Date : Word;π Time : Word;π Reserved : ARRAY[1..8] OF Byte;π CurRec : Byte;π Relative : LongInt;π END;ππ FUNCTION GetLabel(driveNum : Byte;π VAR V : VolString) : Boolean;π CONSTπ Any : String[5] = ':\*.*';π VARπ SR : SearchRec;π Mask : PathStr;π P : Byte;π BEGINπ IF DriveNum > 0 THENπ Mask[1] := Char(DriveNum + ord('@'))π ELSE GetDir(0, Mask);π Move(Any[1], Mask[2], 5);π Mask[0] := #6;π FindFirst(Mask, VolumeID, SR);π WHILE (SR.Attr AND VolumeID = 0) ANDπ (DosError = 0) DOπ FindNext(SR);π IF DosError = 0 THENπ BEGINπ FillChar(V[1], 11, ' ');π V[0] := #11;π P := Pos('.', SR.Name);π IF P = 0 THENπ Move(SR.Name[1], V[1], length(SR.Name))π ELSEπ BEGINπ Move(SR.Name[1], V[1], pred(P));π Move(SR.Name[P+1], V[9], length(SR.Name)-P);π END;π GetLabel := TRUE;π ENDπ ELSE GetLabel := FALSE;π END;ππ FUNCTION SetLabel(driveNum : Byte;π NuLabel : VolString) : Boolean;π VAR E : ExFCB;π BEGINπ WITH E DOπ BEGINπ FF := $FF;π FillChar(Reserved0, 5, 0);π Attribute := VolumeID;π DriveID := DriveNum;π FillChar(FileName, 8, ' ');π FillChar(Extension, 3, ' ');π Move(NuLabel[1], Filename, length(NuLabel));π END;π ASMπ PUSH DSπ MOV AX, SSπ MOV DS, AXπ LEA DX, E {point DS:DX at Extended FCB}π MOV AH, 16h {create using FCB}π INT 21hπ INC ALπ MOV @result, ALπ POP DSπ END;π END;ππ FUNCTION DelLabel(driveNum : Byte) : Boolean;π VAR E : ExFCB;π BEGINπ WITH E DOπ BEGINπ FF := $FF;π FillChar(Reserved0, 5, 0);π Attribute := VolumeID;π DriveID := DriveNum;π FillChar(FileName, 8, '?');π FillChar(Extension, 3, '?');π END;π ASMπ PUSH DSπ MOV AX, SSπ MOV DS, AXπ LEA DX, E {point DS:DX at Extended FCB}π MOV AH, 13h {delete using FCB}π INT 21hπ INC ALπ MOV @Result, ALπ POP DSπ END;π END;πEND. 59 11-02-9305:06ALL WIM VAN VOLLENHOVEN Detecting CD-ROM SWAG9311 5 ╣ {πWIM VAN VOLLENHOVENππ>No, I'm looking for an generic CD-ROM detection routine.π>Thought it was some subfunction of int 2Fh. Don't know if it detectedπ>the presence of a CD-Rom, or the presence of MSCDEX.π}πUsesπ Dos;ππVarπ Regs : Registers;ππProcedure IsCDRom;πbeginπ Regs.AX := $1500;π Regs.BX := $0000;π Regs.CX := $0000;π Intr( $2F, Regs);π writeln('CD Available : ', (Regs.BX > 0));πend;πππbeginπ IsCDRom;πend.π
